• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 397
  • Last Modified:

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

Open in new window

0
RyanVT
Asked:
RyanVT
  • 6
  • 4
1 Solution
 
Antagony1960Commented:
Ah, this looks familiar... :-D

If I understand correctly you want to read in data for the selected customer listed in the 'Selected' list box. What I would do is modify your procedure slightly so that you pass the customer's ID in the call:

Private Sub GetData(ByVal intCustID As Integer)
    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 intProdID As Integer

Now, say you have a 'Get Data' command button which you click to do the read:

Private Sub cmdGetData_Click()
    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 .Column(1, .ListIndex)
        End If
    End With
End Sub
0
 
Antagony1960Commented:
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
0
 
RyanVTAuthor Commented:
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.
0
Get your Conversational Ransomware Defense e‑book

This e-book gives you an insight into the ransomware threat and reviews the fundamentals of top-notch ransomware preparedness and recovery. To help you protect yourself and your organization. The initial infection may be inevitable, so the best protection is to be fully prepared.

 
Antagony1960Commented:
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.
0
 
RyanVTAuthor Commented:
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
0
 
Antagony1960Commented:
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.
0
 
RyanVTAuthor Commented:
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!
0
 
Antagony1960Commented:
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

Open in new window

0
 
Antagony1960Commented:
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
0
 
RyanVTAuthor Commented:
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
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now