RyanVT
asked on
How do I reference a hidden column to call data from a database?
How do I reference a column in an Excel list box to extract data from a access database?
With lstFrom
' First add selected items to lstTo & remove from lstFrom
For i = .ListCount - 1 To 0 Step -1 ' .ListCount = the # of items on a ListBox
If .Selected(i) Then ' .Selected(i) = True if item i is selected
intPosition = Position(.List(i), lstTo)
lstTo.AddItem .List(i), intPosition
'This is the second column the where the ID reference is...
lstTo.Column(1, intPosition) = .Column(1, i)
.RemoveItem i
End If
Next i
End With
Private Sub GetData()
On Error GoTo HandleErrors
Dim i As Integer, j As Integer, curAmount As Currency, ttlNames As Integer
Dim Path As String, strYear As String
Dim cur2003 As Currency, cur2004 As Currency, cur2005 As Currency, cur2006 As Currency, cur2007 As Currency
Dim intCustID As Integer, intProdID As Integer
Path = ThisWorkbook.Path
If Right(Path, 1) <> "\" Then Path = Path & "\"
With Worksheets("Data")
.Range("C3:Z30").Clear
' Put Customer Names in column headings
ttlNames = Worksheets("Selections").lstSelected.ListCount
For i = 0 To ttlNames - 1
.Cells(3, i + 3).Value = Worksheets("Selections").lstSelected.List(i)
.Columns(i + 3).HorizontalAlignment = xlCenter
.Columns(i + 3).AutoFit
Next i
Set db = OpenDatabase(Path & "HokieStore.mdb")
' Run the query to open recordset
sql = "Select * From Products"
Set rs = db.OpenRecordset(sql, dbOpenDynaset)
For j = 1 To ttlNames 'iteration over columns
cur2003 = 0
cur2004 = 0
cur2005 = 0
cur2006 = 0
cur2007 = 0
sql = "Select * From Orders WHERE Customer = " & intCustID
Set rs2 = db.OpenRecordset(sql, dbOpenDynaset)
While Not rs2.EOF
strYear = Right(rs2("Date").Value, 4)
intProdID = rs2("Product").Value
rs.FindFirst "Product_ID = " & intProdID
curAmount = rs2("Units").Value * rs("Unit_Price").Value
Select Case strYear
Case "2003"
cur2003 = cur2003 + curAmount
Case "2004"
cur2004 = cur2004 + curAmount
Case "2005"
cur2005 = cur2005 + curAmount
Case "2006"
cur2006 = cur2006 + curAmount
Case "2007"
cur2007 = cur2007 + curAmount
End Select
rs2.MoveNext
Wend
.Cells(4, 2 + j).Value = cur2003
.Cells(5, 2 + j).Value = cur2004
.Cells(6, 2 + j).Value = cur2005
.Cells(7, 2 + j).Value = cur2006
.Cells(8, 2 + j).Value = cur2007
.Cells(10, 2 + j) = cur2003 + cur2004 + cur2005 + cur2006 + cur2007
.Cells(12, 2 + j) = Format(((cur2003 + cur2004 + cur2005 + cur2006 + cur2007) / 5), "Currency")
Next j
rs.Close
rs2.Close
db.Close
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing ' Frees space used by object variables
.Columns(2).HorizontalAlignment = xlCenter
.Columns(2).AutoFit
.Select
.Cells(1, 9).Select
Dim rNames As String
Dim rValues As String
.Range("C10").Select
If (ttlNames > 1) Then
rValues = Selection.End(xlToRight).Address
Else
rValues = "$C$10"
End If
.Range("C3").Select
If (ttlNames > 1) Then
rNames = Selection.End(xlToRight).Address
Else
rNames = "$C$3"
End If
End With
Exit Sub
HandleErrors:
MsgBox "Unable to carry out requested operation"
On Error GoTo 0 'Turn off error trapping
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
One thing to note: I see you have assigned the customer ID to an integer (inCustID). Did you know that variable type has a rather limited range (32,767)? Typically database ID fields are defined as long integers which have a much greater range (2,147,483,647). So, it is best practise to always assign database id fields to the Long variable type rather than integer. e.g. lngCustID As Long
ASKER
I'm getting closer! What is happening now is that for every name in the lstSelected, when I click cmdData it returns the same values for every person. So I went from getting zeros across the board to getting all the same number.
That's odd, it should work.
Okay, the first thing you should do is verify that the hidden columns in the two list boxes are being populated with the correct data. You can do this by temporarily making the 2nd column visible, i.e. set their widths to, say 20--remember the code I suggested you put in UserForm_Initialize: <listbox>.ColumnWidths = iColWidth & ";20")? If the column has a different number on each row and that number is being transferred when you swap the items about, that would suggest the filling and swapping code is okay.
The next thing to try is to put a stop inside the cmdData_Click event and check: a) that the ListIndex property is changing to match the currently selected row; and b) that the value in .Column(1, .ListIndex) is correct and is being passed to the GetData procedure. Put another stop on the "sql =" line (line 50 in the code snippet you posted above) and when execution is paused in the command button and you've verified the ID is correct there, press F5 and the program will run to the sql statement and you can check then value is still correct.
Failing that, let me know your findings.
Okay, the first thing you should do is verify that the hidden columns in the two list boxes are being populated with the correct data. You can do this by temporarily making the 2nd column visible, i.e. set their widths to, say 20--remember the code I suggested you put in UserForm_Initialize: <listbox>.ColumnWidths = iColWidth & ";20")? If the column has a different number on each row and that number is being transferred when you swap the items about, that would suggest the filling and swapping code is okay.
The next thing to try is to put a stop inside the cmdData_Click event and check: a) that the ListIndex property is changing to match the currently selected row; and b) that the value in .Column(1, .ListIndex) is correct and is being passed to the GetData procedure. Put another stop on the "sql =" line (line 50 in the code snippet you posted above) and when execution is paused in the command button and you've verified the ID is correct there, press F5 and the program will run to the sql statement and you can check then value is still correct.
Failing that, let me know your findings.
ASKER
It seems like it is only referencing the last ID number of the list box for the entire list no matter how many names are in the list box
Right... the code in your procedure has not been written to accept more than one ID at a time, so the code I've given you is for returning the data associated to the last item clicked on (that's what .ListIndex indicates) in the list box.
Are you saying you need to pull out the data for ALL the customers in lstSelected? Because that will be a different proposition.
Are you saying you need to pull out the data for ALL the customers in lstSelected? Because that will be a different proposition.
ASKER
I'm sorry about that, yes when I click cmdData it is placing the information for every customer in a chart on a separate sheet. Multiple values at the same time. Thanks for your help, I'm obviously not good at this stuff!
Ok, try this:
Private Sub cmdGetData_Click()
Dim i As Integer, s As String
With lstSelected
If .ListCount = 0 Then 'Nothing to import'
MsgBox "The Selected list is empty!"
ElseIf .ListIndex = -1 Then 'No item selected'
MsgBox "Please select a customer to import."
Else
GetData
End If
End With
End Sub
Private Sub GetData()
On Error GoTo HandleErrors
Dim i As Integer, j As Integer, curAmount As Currency, ttlNames As Integer
Dim Path As String, strYear As String
Dim cur2003 As Currency, cur2004 As Currency, cur2005 As Currency, cur2006 As Currency, cur2007 As Currency
Dim strCustID As String, intProdID As Integer
Path = ThisWorkbook.Path
If Right(Path, 1) <> "\" Then Path = Path & "\"
With Worksheets("Data")
.Range("C3:Z30").Clear
' Put Customer Names in column headings
ttlNames = Worksheets("Selections").lstSelected.ListCount
For i = 0 To ttlNames - 1
.Cells(3, i + 3).Value = Worksheets("Selections").lstSelected.List(i)
.Columns(i + 3).HorizontalAlignment = xlCenter
.Columns(i + 3).AutoFit
Next i
Set Db = OpenDatabase(Path & "HokieStore.mdb")
' Run the query to open recordset
Sql = "Select * From Products"
Set rs = Db.OpenRecordset(Sql, dbOpenDynaset)
For j = 1 To ttlNames 'iteration over columns
cur2003 = 0
cur2004 = 0
cur2005 = 0
cur2006 = 0
cur2007 = 0
strCustID(i) = Worksheets("Selections").lstSelected.Column(1, j - 1)
Sql = "Select * From Orders WHERE Customer = " & strCustID
Set rs2 = Db.OpenRecordset(Sql, dbOpenDynaset)
While Not rs2.EOF
strYear = Right(rs2("Date").Value, 4)
intProdID = rs2("Product").Value
rs.FindFirst "Product_ID = " & intProdID
curAmount = rs2("Units").Value * rs("Unit_Price").Value
Select Case strYear
Case "2003"
cur2003 = cur2003 + curAmount
Case "2004"
cur2004 = cur2004 + curAmount
Case "2005"
cur2005 = cur2005 + curAmount
Case "2006"
cur2006 = cur2006 + curAmount
Case "2007"
cur2007 = cur2007 + curAmount
End Select
rs2.MoveNext
Wend
.Cells(4, 2 + j).Value = cur2003
.Cells(5, 2 + j).Value = cur2004
.Cells(6, 2 + j).Value = cur2005
.Cells(7, 2 + j).Value = cur2006
.Cells(8, 2 + j).Value = cur2007
.Cells(10, 2 + j) = cur2003 + cur2004 + cur2005 + cur2006 + cur2007
.Cells(12, 2 + j) = Format(((cur2003 + cur2004 + cur2005 + cur2006 + cur2007) / 5), "Currency")
Next j
rs.Close
rs2.Close
Db.Close
Set rs = Nothing
Set rs2 = Nothing
Set Db = Nothing ' Frees space used by object variables
.Columns(2).HorizontalAlignment = xlCenter
.Columns(2).AutoFit
.Select
.Cells(1, 9).Select
Dim rNames As String
Dim rValues As String
.Range("C10").Select
If (ttlNames > 1) Then
rValues = Selection.End(xlToRight).Address
Else
rValues = "$C$10"
End If
.Range("C3").Select
If (ttlNames > 1) Then
rNames = Selection.End(xlToRight).Address
Else
rNames = "$C$3"
End If
End With
Exit Sub
HandleErrors:
MsgBox "Unable to carry out requested operation"
On Error GoTo 0 'Turn off error trapping
End Sub
One anomaly which I haven't changed is the While/Wend/MoveNext routine around rs2, which seems superfluous to me as it should only ever return one record per customer there, if your database is set up properly. I would drop the MoveNext and change the while/wend to a simple If Not .EOF Then/End If
ASKER
Thanks for the help, I was able to figure it out. A lot of it had to do with making sure every time I referenced the listbox I defined both columns. Thanks Again