How can I search matching values or items selected

2019-07-26 07:42发布

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

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

2条回答
叛逆
2楼-- · 2019-07-26 07:49

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
查看更多
倾城 Initia
3楼-- · 2019-07-26 08:09

You could loop through your first ListBox and pass the value into this function.

The second argument should only be the column range you are looking for values in. The function does an offset from there.

Public Sub FindMyStuff(FindWhat As String, dataRange As Range, ByRef listbox As listbox)
    Dim cell As Range
    For Each cell In dataRange
        If cell.Value = FindWhat Then
            listbox.AddItem cell.Offset(0, 2)
        End If
    Next cell
End Sub
查看更多
登录 后发表回答