Hi everyone,

Problem description: I have a listBox "Filters" and 3 other ListBoxes containing unique values from 3 columns across 3 different sheets. I would like to select one or more filters in listBox "Filters" and use it to tick checkboxes wherever filter text occures in 3 other ListBoxes, so it should work as "contains" -> see simulation on the screenshot. I know ListBox has Selected propertie but I do not have any idea how to use it to tick other checkboxes.

-----------UserForm1------------
Private Sub UserForm_Activate()

Dim r As Range
With Worksheets("Carriers")
        Set r = .Range("A2", .Range("A1000").End(xlUp))
        
        Me.lstB_Carriers.RowSource = "Carriers!" & r.Address
End With
End Sub
--------------Module1---------------
Sub SentUpdate()    

RemoveDuplicatesNLOB
Call Module2.RemoveDuplicatesNLIB
Call Module3.RemoveDuplicatesHUOB

UserForm1.Show


End Sub

Sub RemoveDuplicatesNLOB()

  On Error Resume Next
    Sheet2.ShowAllData
  On Error GoTo 0

    Dim AllCells As Range, Cell As Range
    Dim NoDupes As Collection, NoDupesSorted As Collection
    Dim i As Long, j As Long
    Dim Item As Variant

    Set NoDupes = New Collection

    Set AllCells = Sheet2.Range("D5:D" & Sheet2.Range("D10000").End(xlUp).Row)

    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell

    On Error GoTo 0


    With UserForm1
        .lbl_totalLSP_NLOB.Caption = "Total Items: " & AllCells.count
    End With

    Set NoDupesSorted = New Collection

    NoDupesSorted.Add NoDupes(1), CStr(NoDupes(1))

    For i = 2 To NoDupes.count
        For j = 1 To NoDupesSorted.count
            If NoDupes(i) < NoDupesSorted(j) Then
                NoDupesSorted.Add NoDupes(i), CStr(NoDupes(i)), j
                Exit For
            End If
        Next j
    Next i

    For Each Item In NoDupesSorted
        UserForm1.lstB_NLOB.AddItem Item
    Next Item

End Sub

Hi everyone,

Problem description: I have a listBox "Filters" and 3 other ListBoxes containing unique values from 3 columns across 3 different sheets. I would like to select one or more filters in listBox "Filters" and use it to tick checkboxes wherever filter text occures in 3 other ListBoxes, so it should work as "contains" -> see simulation on the screenshot. I know ListBox has Selected propertie but I do not have any idea how to use it to tick other checkboxes.

-----------UserForm1------------
Private Sub UserForm_Activate()

Dim r As Range
With Worksheets("Carriers")
        Set r = .Range("A2", .Range("A1000").End(xlUp))
        
        Me.lstB_Carriers.RowSource = "Carriers!" & r.Address
End With
End Sub
--------------Module1---------------
Sub SentUpdate()    

RemoveDuplicatesNLOB
Call Module2.RemoveDuplicatesNLIB
Call Module3.RemoveDuplicatesHUOB

UserForm1.Show


End Sub

Sub RemoveDuplicatesNLOB()

  On Error Resume Next
    Sheet2.ShowAllData
  On Error GoTo 0

    Dim AllCells As Range, Cell As Range
    Dim NoDupes As Collection, NoDupesSorted As Collection
    Dim i As Long, j As Long
    Dim Item As Variant

    Set NoDupes = New Collection

    Set AllCells = Sheet2.Range("D5:D" & Sheet2.Range("D10000").End(xlUp).Row)

    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
    Next Cell

    On Error GoTo 0


    With UserForm1
        .lbl_totalLSP_NLOB.Caption = "Total Items: " & AllCells.count
    End With

    Set NoDupesSorted = New Collection

    NoDupesSorted.Add NoDupes(1), CStr(NoDupes(1))

    For i = 2 To NoDupes.count
        For j = 1 To NoDupesSorted.count
            If NoDupes(i) < NoDupesSorted(j) Then
                NoDupesSorted.Add NoDupes(i), CStr(NoDupes(i)), j
                Exit For
            End If
        Next j
    Next i

    For Each Item In NoDupesSorted
        UserForm1.lstB_NLOB.AddItem Item
    Next Item

End Sub

• excel
• vba
• listbox
• userform

• I suggest using Application.EnableEvents = False. It prevents the Change event from triggering itself recursively. It's crucial to re-enable events with Application.EnableEvents = True when done, otherwise other event-driven code in your workbook might not function correctly. – user80346 Commented 2 days ago
• @user80346 - This is a UserForm, and EnableEvents has no effect: cpearson/excel/SuppressChangeInForms.htm – Tim Williams Commented 2 days ago

1 Answer 1

Here's how it could look:

Option Explicit

'load some dummy data
Private Sub UserForm_Activate()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Test")
    Me.ListBox1.RowSource = ws.Range("A1:A12").Address(external:=True)
    Me.ListBox2.RowSource = ws.Range("B1:B12").Address(external:=True)
    Me.ListBox3.RowSource = ws.Range("C1:C12").Address(external:=True)
End Sub

'handle changes in "master" listbox
Private Sub ListBox1_Change()
    Dim selItems As Collection
    
    Set selItems = SelectedItems(Me.ListBox1)
    'check/uncheck in other listboxes
    CheckMatches selItems, Me.ListBox2
    CheckMatches selItems, Me.ListBox3
End Sub

'select any items in `lbDest` which contain the text of any item in `col`
Sub CheckMatches(col As Collection, lbDest As MSForms.ListBox)
    Dim i As Long, v, itm, sel As Boolean
    
    For i = 0 To lbDest.ListCount - 1
        sel = False          'reset flag
        v = lbDest.List(i)   'item value
        For Each itm In col
            If InStr(1, v, itm, vbTextCompare) > 0 Then 'contains a checked item?
                sel = True 'flag for selection
                Exit For
            End If
        Next itm
        lbDest.Selected(i) = sel
    Next i
End Sub

'return a collection of selected items from `lb`
Function SelectedItems(lb As MSForms.ListBox) As Collection
    Dim col As New Collection, i As Long
    For i = 0 To lb.ListCount - 1
        If lb.Selected(i) Then col.Add lb.List(i)
    Next i
    Set SelectedItems = col
End Function

My dummy data: