Thread: How to populate multiple column listbox with unique combinations only

Hello shuvajit,

Welcome to the Forum!

This should get you started. Now when you select a user's name from the CombBox, a unique list of names is produced in the ListBox. Here is the UserForm code. The attached workbook has all the changes.

Public Dic As Object

Private Sub ComboBox1_Click()

    Dim Data As Variant
    Dim I As Long, J As Long
    Dim R As Long
    Dim Users As Collection
    
        If ComboBox1.ListIndex = -1 Then Exit Sub
        
        Data = Dic(ComboBox1.Value)
        
        Data = Split(Data, ",")
        
        ListBox1.Clear
        ListBox1.ColumnCount = 6
        
        Set Users = New Collection
        
            For I = 0 To UBound(Data)
                Set Rng = Cells(Data(I), "C").Resize(ColumnSize:=5)
                User = WorksheetFunction.Index(Rng.Value, 1, 0)
                User = Application.Trim(Join(User, " "))
                On Error Resume Next
                    Users.Add 1, User
                    If Err = 0 Then
                       ListBox1.AddItem
                       For J = 0 To 4
                           ListBox1.List(ListBox1.ListCount - 1, J) = Rng.Cells(I + 1, J + 1)
                       Next J
                    End If
                On Error GoTo 0
            Next I
        
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
Unload Me
UserForm2.Show
End Sub

Private Sub CommandOk_Click()
UserForm1.Hide
Unload Me
UserForm2.Show
End Sub

Private Sub UserForm_Initialize()

    Dim Cell As Range
    Dim Data As Variant
    Dim I As Long
    Dim Item As String
    Dim Key As Variant
    Dim Rng As Range
    Dim LastRow As Long
    
        LastRow = Cells(Rows.Count, "B").End(xlUp).Row
        Set Rng = Range("B2:B" & LastRow)
        
        R = Rng.Row
        Data = Rng.Value
        
        Set Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMode = vbTextCompare
        
            For I = 1 To UBound(Data)
                Key = Trim(Data(I, 1))
                If Key <> "" Then
                   Item = R + I - 1
                   If Not Dic.Exists(Key) Then
                      Dic.Add Key, Item
                   Else
                      Item = Dic(Key) & "," & Item
                      Dic(Key) = Item
                   End If
                End If
            Next I
        
        ComboBox1.List = Dic.Keys

End Sub