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

[illogic]

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?

[gmayor]

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 (http://www.gmayor.com/Userform_ComboBox.html)

[illogic]

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.

[gmayor]

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.