How can I search matching values or items selected from a useform multiselect listbox from a sheet?

Question

I am new in excel-VBA. I have two(2) multiselect listbox in a userform. listbox#1 contains a list of items that I retrieve from a range of cells in a worksheet(ex.Sheet1). I would like to add a new list of items to listbox#2 if the values selected in listbox#1 matches the cell value from sheet2 column A. For instance, If the selected items from listbox#1 matches the value in a cell from column A then get the values of the adjacent column (Column C) and add it to listbox#2. NOTE: sometimes there are duplicate values in column A I want to get all of the values from the adjacent column ("C") too.

Thank you!

Screenshot

Here is my code so far.

Dim rng1 As Range
Dim rng2 As Range
Dim ws As Worksheet
Dim i As Integer
Dim j As Long
Dim k As Long
        
    Set ws = Sheets("Class_DataSheet")'from Sheet2
    
    On Error Resume Next
    
    For i = 2 To ws.Cells.Find(What:="*", LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False).Row Step 1
    
    Set rng1 = ws.Range("A" & i)
    Set rng2 = ws.Range("C" & i)
    
    With Schedulefrm.SchedDateTimelist ' Listbox#2
        For k = 0 To Schedulefrm.ClassIDList.ListCount - 1 'ClassIDList is listbox#1
            If Schedulefrm.ClassIDList.Selected(k) Then
                If Schedulefrm.ClassIDList.List(k) = rng1.Value Then
                    .Clear
                    .AddItem rng2.Value 'it adds only one last value of the column ("C") from sheet2
                     For j = 0 To .ListCount - 1
                            .Selected(j) = True
                        Next j
                End If
            End If
        Next k
    End With
    
    Next i

Don't use Excel for what should be done with a database. You should look into Microsoft Access for this project. — Michael Z.
If you really want this to be efficient then you should grab your entire Excel range into an array and do your lookups on the array. You could write a function that looks up each listbox item one at a time and return that result then move on to the next listbox item. This breaks down your task into smaller chunks instead of trying to think about the big picture solution. — Michael Z.

user3598756 user3598756 · Accepted Answer · 2016-05-27T17:51:45

try this

edited after OP's clarifications about duplicates handling

Option Explicit

Private Sub ClassIDList_Change()
    Dim k As Long
    Dim dataIDRng As Range, found As Range
    Dim firstAddress As String

    With Worksheets("Class_DataSheet") 'from Sheet2
        Set dataIDRng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
    End With

    With Schedulefrm
        .SchedDateTimelist.Clear
        With .ClassIDList
            For k = 0 To .ListCount - 1
                If .Selected(k) Then
                    Set found = dataIDRng.Find(What:=.List(k), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                    If Not found Is Nothing Then
                        firstAddress = found.Address '<~~ store the found cell address
                        Do '<~~ start a loop through all range cells to find those matching the selected item. it'll wrap around to the beginning of he range once reached its end
                            Schedulefrm.SchedDateTimelist.AddItem found.Offset(, 2)
                            Set found = dataIDRng.FindNext(found) '<~~ look for next matching cell
                        Loop While found.Address <> firstAddress '<~~ loop until you hit the first found cell again
                    End If
                End If
            Next k
        End With
    End With
End Sub

How can I search matching values or items selected from a useform multiselect listbox from a sheet?

Screenshot

2 Answers