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:

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.

Code:

---

                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?

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

Code:

---

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

---

Code:

---

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

Quote:

---

Originally Posted by gmayor

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.

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.