Using a List Box to filter another List Box

[Liz]

Hi,
I have two multi-select listboxes. The selections from ListBox 1 will
determine the and filter the available choices for Listbox 2.
I do have code that works when a combobox is used as the source to filter a
listbox. But I am not sure how I can modify it to accommodate a multi-select
listbox as the source.
Thanks for your help!

My code is below which works when a single select combo box is used as the
source:

Private Sub cboxProductLine_Change()
Dim myRng As Range
Dim myCell As Range
If Me.cboxProductLine.ListIndex < 0 Then
Me.lstProductFiltered.ListIndex = -1
End If

With Worksheets("LOVs")
Set myRng = .Range("ProductFilter") 'Using a dynamic named range
End With

'Clear list index if it already exists.
With lstProductFiltered
.Clear
End With

For Each myCell In myRng.Cells
If LCase(myCell.Value) = LCase(Me.cboxProductLine.Value) Then
Me.lstProductFiltered.AddItem myCell.Offset(0, 1).Value
End If
Next myCell
End Sub

 

[Dave Peterson]

So you want to do the same kind of thing -- loop through a column of cells to
check to see if the value of any of the selected items in listbox matches.

If it does match, then put a value on the same row into listbox2 (some
offset???).

I created a small userform with two listboxes and a single commandbutton.

This is the code behind the userform:

Option Explicit
Private Sub CommandButton1_Click()

Dim iCtr As Long
Dim sCtr As Long 'selected counter
Dim SelectedList() As String 'that's what the listbox displays!
Dim res As Variant
Dim myCell As Range
Dim myRng As Range

With Worksheets("Sheet1")
'my test data on sheet1
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

sCtr = -1
With Me.ListBox1
ReDim SelectedList(0 To .ListCount - 1)
For iCtr = 0 To .ListCount - 1
If .Selected(iCtr) = True Then
sCtr = sCtr + 1
ReDim Preserve SelectedList(0 To sCtr)
SelectedList(sCtr) = .List(iCtr)
End If
Next iCtr
End With

If sCtr = -1 Then
'this shouldn't happen, because the commandbutton
'was disabled until at least one item was selected!
MsgBox "Design error!"
Exit Sub
End If

'just keep the elements that were chosen
ReDim Preserve SelectedList(0 To sCtr)

With Me.ListBox2
.Clear 'clean up any old values
For Each myCell In myRng.Cells
res = Application.Match(myCell.Value, SelectedList, 0)
If IsError(res) Then
'not a match, don't add it
Else
.AddItem myCell.Offset(0, 1).Value
'multiple columns in listbox2????
'make sure you match the _initialize .columncount value!
.List(.ListCount - 1, 1) = myCell.Offset(0, 2).Value
End If
Next myCell
End With

End Sub
Private Sub ListBox1_Change()
Dim iCtr As Long

Me.CommandButton1.Enabled = False
With Me.ListBox1
For iCtr = 0 To .ListCount - 1
If .Selected(iCtr) = True Then
'ok to click button1
Me.CommandButton1.Enabled = True
Exit For 'stop checking
End If
Next iCtr
End With
End Sub
Private Sub UserForm_Initialize()

Dim iCtr As Long

'set up and some test data
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
For iCtr = 1 To 5
.AddItem "a" & iCtr
Next iCtr
End With

With Me.ListBox2
.ColumnCount = 2 'change to the correct number!
.ColumnWidths = "44;44"
.MultiSelect = fmMultiSelectMulti 'whatever you want
End With

With Me.CommandButton1
.Caption = "Populate LB2"
.Enabled = False
End With

End Sub

 

[Liz]

Hi Dave,
This works beautifully! Just what I was looking for.

I can now see why a command button fits the bill too. Makes sense that would
simplify the "refresh" of the 2nd listbox when items are selected/removed
from the first list box.

Thanks so much for the quick assistance!
Best,
Liz