Consulting

Results 1 to 4 of 4

Thread: VBA Word/Excel - Populate ListBox with data from Excel Workbook (multiple sheets)

  1. #1
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location

    VBA Word/Excel - Populate ListBox with data from Excel Workbook (multiple sheets)

    Hello,

    I am again having some troubles with a macro from gmayor i found here on the forums.
    I have two ListBoxes in my UserForm.
    The first ListBox is populated with items during Userform initialization.
    The second ListBox should get its content from the selected item of the first ListBox.
    The content itself is stored in a Workbook with multiple sheets each with different names and different content.
    The content of each sheet is stored in Column A, but the amount of data varies from sheet to sheet.
    Some sheets have content from A1:A5, others may have content from A1:A10 and so on.

    I found this code and tried to make it work, but so far i fail to make the macro get the content from the sheets column range.
    However it works with a single cell (A1).

    Code:
    Option Explicit
    
    Private Const strWorkbook As String = "C:\artexPrüfprotokolle\Tankschutzarmaturen\Vorlagen\findingsDB.xlsx"        'The path of the workbook
    Private Const strSheet1 As String = "Flammensicherung"        'The name of the worksheet (or range)
    Private Const strSheet2 As String = "Ventilteller"        'The name of the worksheet (or range)
    Private Const strSheet3 As String = "Ventilsitze"        'The name of the worksheet (or range)
    Private Const strSheet4 As String = "Gehäuse"        'The name of the worksheet (or range)
    Private Const strSheet5 As String = "Hinweise"        'The name of the worksheet (or range)
    
    Public Sub UserForm_Initialize()
        Dim gasketList, flameArresterList, ventDiscList, miscList, findingsPreSelectionList, findingsSelection As Variant
        
        findingsPreSelectionList = Array("Flammensicherung", "Ventilteller", "Ventilsitze", "Gehäuse", "Hinweise")
        ListBox5.List = findingsPreSelectionList
        
        findingsSelection = Array(sFind)
    End Sub
    
    Private Function xlFillArray(strWorkbook As String, strRange1 As String, strRange2 As String, strRange3 As String, strRange4 As String, strRange5 As String) As Variant
    'Graham Mayor - http://www.gmayor.com - 24/09/2016
    Dim RS As Object
    Dim CN As Object
    Dim iRows As Long
    
        strRange1 = strRange1 & "$]"    'Use this to work with a named worksheet
        strRange2 = strRange2 & "$]"    'Use this to work with a named worksheet
        strRange3 = strRange3 & "$]"    'Use this to work with a named worksheet
        strRange4 = strRange4 & "$]"    'Use this to work with a named worksheet
        strRange5 = strRange5 & "$]"    'Use this to work with a named worksheet
        'strRange = strRange & "]" 'Use this to work with a named range
        Set CN = CreateObject("ADODB.Connection")
    
        'Set HDR=YES for a sheet or range with a header row
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
    
        Set RS = CreateObject("ADODB.Recordset")
        RS.Open "SELECT * FROM [" & strRange1, CN, 2, 1
    
        With RS
            .MoveLast
            iRows = .RecordCount
            .MoveFirst
        End With
        xlFillArray = RS.GetRows(iRows)
        If RS.State = 1 Then RS.Close
        Set RS = Nothing
        If CN.State = 1 Then CN.Close
        Set CN = Nothing
    lbl_Exit:
        Exit Function
    End Function
    
    Private Sub ListBox5_Click()
        Dim i As Integer
        Dim Arr() As Variant
        Dim sFind As String
        Dim TestMsg As Variant
        Dim findingsSelection As Variant
        
        For i = 0 To ListBox5.ListCount - 1
            If ListBox5.Selected(i) Then
                If ListBox5.List(i) = "Flammensicherung" Then
                    Arr = xlFillArray(strWorkbook, strSheet1, strSheet2, strSheet3, strSheet4, strSheet5)
                    sFind = Arr(0, 0) 'What do i need to add here to populate the Array with all content from Column A (from first to last used row).
                    'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This does not work (Method 'rows' for Object '_Global' failed), i don't know if this is the proper syntax (guess not).
                    TestMsg = sFind
                    MsgBox (TestMsg)
    lbl_Exit:
                    Exit Sub
                End If
            End If
        Next i
    End Sub
    This Line of Code works with a single Cell A1
    But i can't get it to work with a range of cells in column A to the last used cell of that column.
                    sFind = Arr(0, 0) 'This works.
    
                    'sFind = Arr(Cells(Rows.Count, 1).End(xlUp).Row) // This  does not work (Method 'rows' for Object '_Global' failed), i don't know  if this is the proper syntax (guess not).
    Does anyone know a solution to this?

  2. #2
    You have certainly taken some liberties with the XLFillArray function I posted which was as below.

    The array is filled with all the values from the worksheet or the named range.
    You can interrogate the array e.g. as follows after defining what strWorkbook and strSheet are. In this case it loops through each row of a vehicle data file and checks the values in columns 1, 7 and 8

    Sub GetValues()
    Dim arr() As Variant
    Dim i As Long
    Dim sChassis As String
    Dim sMake As String
    Dim sModel As String
        arr = xlFillArray(strWorkbook, strSheet)
        For i = 0 To UBound(arr, 2)
            sChassis = arr(1, i)
            sMake = arr(7, i)
            sModel = arr(8, i)
            If sMake = "BMW" And sModel = "X5" Then
                MsgBox sChassis & vbCr & sMake & Chr(32) & sModel
                Exit For
            End If
        Next i
    lbl_Exit:
        Exit Sub
    End Sub
    Private Function xlFillArray(strWorkbook As String, _                             strRange As String) As Variant
    'Graham Mayor - http://www.gmayor.com - 24/09/2016
    Dim RS As Object
    Dim CN As Object
    Dim iRows As Long
    
    
        strRange = strRange & "$]"    'Use this to work with a named worksheet
        'strRange = strRange & "]" 'Use this to work with a named range
        Set CN = CreateObject("ADODB.Connection")
    
    
        'Set HDR=NO for no header row
        CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                  "Data Source=" & strWorkbook & ";" & _
                                  "Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"""
    
    
        Set RS = CreateObject("ADODB.Recordset")
        RS.Open "SELECT * FROM [" & strRange, CN, 2, 1
    
    
        With RS
            .MoveLast
            iRows = .RecordCount
            .MoveFirst
        End With
        xlFillArray = RS.getrows(iRows)
        If RS.State = 1 Then RS.Close
        Set RS = Nothing
        If CN.State = 1 Then CN.Close
        Set CN = Nothing
    lbl_Exit:
        Exit Function
    End Function
    If you want to fill a userform with an Excel sheet or named range then see https://www.gmayor.com/Userform_ComboBox.html
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Jun 2016
    Posts
    53
    Location
    Quote Originally Posted by gmayor View Post
    You have certainly taken some liberties with the XLFillArray function I posted which was as below.
    I am sorry about that. I did not mean to distort your work. I am just trying to understand how this code functions and find a solution for my specific problem.

    Thanks for the link, i have taken a look into it. Please correct me if i am wrong, but from what i understand so far, the code does not work with a workbook that contains more than one named worksheets? Is that correct?
    I have a workbook with several named sheets, each containing specific datasets. To keep it clean i would like to poulate the listbox only with data from a certain worksheet determined by the selection of another listbox.

    If i put all the data in a single column of a single worksheet, it becomes very confusing for the user to find the specific data he needs.

  4. #4
    You can work with as many workbooks and worksheets as you have, but only one at a time. It is just a matter of calling the code to include the appropriate workbook/worksheet as required.
    The process is almost instantaneous even with large worksheets.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •