VBA - populate ListBox from multiple ListObjects - excel

Question

I am trying to populate a ListBox with entries from multiple ListObjects.
But not all entries should be populated, only those which have a specific value in a column of the ListObject.
Example:
ListObjects consist of 3 columns: [Name], [Size], [Position]
All entries from ListObject1 to ListObject5 should be populated into the ListBox if the value in column [Position] is "Top".
Next question based on that result:
How can I then in a second ListBox display all entries of the depended ListObject where [Position] is not "Top".
In other words, not all entries which are not "Top" from all ListObjects should be displayed in the second LIstBox, only those possible entries from the specific ListObject where the value picked in the first ListBox matches.
My thoughts where maybe strange, but what about creating a whole new table (maybe an Array), which consists of all entries from all ListObjects which will be generated when opening the UserForm and then add a third column to it - [ListObjectNumber] - which consists of the information from which Table this information is coming from, that would help the second ListBox to only display the right entries... but maybe this is too far ahead.
Thank you for your help!

Answer 1

In a spreadsheet laid out as such:
Formatted via the Home tab with "Format as Table"; this creates ListObjects
named automatically as "Table1", "Table2", "Table3", "Table4", "Table5"
Sheet named "listbox" for example
ActiveX command button added to show the user form named frmListbox in this example:
Sub Button2_Click()
frmListbox.Show
End Sub
Private Sub cmdPopulate_Click()
Dim ws As Worksheet
Dim table As ListObject
Dim rng As Range
Dim i As Long, j As Long, criteriaRow As Long, lastCol As Long
Dim myarray() As String
With Me.lbUsed
'Set relevant sheetname (or create loop for worksheets)
Set ws = Sheets("listbox")
criteriaRow = -1
For Each table In ws.ListObjects
'Set relevant range/table
'Remember: top row are headings
Set rng = ws.Range(table)
'Remember: last colum not displayed in listbox (-1) for this example
lastCol = rng.Columns.Count - 1
.Clear
.ColumnHeads = False
.ColumnCount = lastCol
'Remember: leave out row 0; column headings
For i = 1 To rng.Rows.Count
If (rng.Cells(i, 3) = "Top") Then
criteriaRow = criteriaRow + 1
'Columns go in first demension so that rows can resize as needed
ReDim Preserve myarray(lastCol, criteriaRow)
For j = 0 To lastCol
myarray(j, criteriaRow) = rng.Cells(i, j + 1)
Next 'Column in table
End If
Next 'Row in table
Next 'Table (ListObject)
'Place array in natural order to display in listbox
.List = TransposeArray(myarray)
'Set the widths of the column, separated with a semicolon
.ColumnWidths = "100;75"
.TopIndex = 0
End With
End Sub
Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
Xupper = UBound(myarray, 2)
Yupper = UBound(myarray, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = myarray(Y, X)
Next Y
Next X
TransposeArray = tempArray
End Function
For the 2nd question:
The code sample below shows how when clicking on an item in a list called lstDisorder populates the next list box called lstTreatment with the values from named ranges on the spreadsheet.
Private Sub lstDisorder_Click()
Dim x As Integer
x = lstDisorder.ListIndex
Select Case x
Case Is = 0
lstTreatment.RowSource = "Depression"
Case Is = 1
lstTreatment.RowSource = "Anxiety"
Case Is = 2
lstTreatment.RowSource = "OCD"
Case Is = 3
lstTreatment.RowSource = "Stubstance"
End Select
End Sub
Here is another approach:
Private Sub lstTeam_Click()
Dim colUniqueItems As New Collection
Dim vItem As Variant
Dim rFound As Range
Dim FirstAddress As String
'First listBox
Me.lstItems.Clear
'populate first listBox from range on worksheet
With Worksheets("Team").Range("A2:A" & (Cells(1000, 1).End(xlUp).row))
'Find what was clicked in first listBox
Set rFound = .Find(what:=lstTeam.Value, LookIn:=xlValues, lookat:=xlWhole)
'If something is selected, populate second listBox
If Not rFound Is Nothing Then
'Get the address of selected item in first listBox
FirstAddress = rFound.Address
On Error Resume Next
Do
'Add the value of the cell to the right of the cell selected in first listBox to the collection
colUniqueItems.Add rFound.Offset(, 1).Value, CStr(rFound.Offset(, 1).Value)
'Find the next match in the range of the first listBox
Set rFound = .FindNext(rFound)
'Keep looking through the range until there are no more matches
Loop While rFound.Address <> FirstAddress
On Error GoTo 0
'For each item found and stored in the collection
For Each vItem In colUniqueItems
'Add it to the next listBox
Me.lstItems.AddItem vItem
Next vItem
End If
End With
End Sub
Here's a good resource on listBox which shows how to populate ListBox from an Array and how to Get Selected Items from ListBox1 to ListBox2 and more.