Adding unique items in listboxes

[SamirBhowmik]

Hello,

I am new to vba, I have a userform with multiple listboxes where the data are from a table called"DynamicPath_2". Attached is a screenshot of the userform.

For the below code which I managed to make work for me for the first ListBox1, can anyone help me to modify the code to populate all the listBoxes with only unique values from the table columns. Also if possible to fasten the execution because currently this code is already slowing the loading of the userform, I imagine it would afftect more if I complete the code for 10 listboxes : (

Private Sub UserForm_Initialize()
Dim UniqueList()    As String
    Dim X               As Long
    Dim Rng1, Rng2           As Range
    Dim c               As Range
    Dim Unique          As Boolean
    Dim Y               As Long
    
    Set Rng1 = Sheets("MDB").Range("A2:A60000")
    Set Rng2 = Sheets("MDB").Range("C2:C60000")
    Y = 1
    
    ReDim UniqueList(1 To Rng1.Rows.Count)
    ReDim UniqueList(1 To Rng2.Rows.Count)
    
    For Each c In Rng1
        If Not c.Value = vbNullString Then
            Unique = True
            For X = 1 To Y
                If UniqueList(X) = c.Text Then
                    Unique = False
                End If
            Next
            If Unique Then
                Y = Y + 1
                Me.ListBox1.AddItem (c.Text)
                UniqueList(Y) = c.Text
            End If
        End If
    Next
For Each c In Rng2
        If Not c.Value = vbNullString Then
            Unique = True
            For X = 1 To Y
                If UniqueList(X) = c.Text Then
                    Unique = False
                End If
            Next
            If Unique Then
                Y = Y + 1
                Me.ListBox2.AddItem (c.Text)
                UniqueList(Y) = c.Text
            End If
        End If
    Next
End Sub

Thank you

 

[DanteAmor]

In your image I don't see a listbox. Do you mean listbox or combobox?


Try this:

Private Sub UserForm_Initialize()
  Dim a() As Variant
  Dim dic As Object
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("MDB").Range("A2", Sheets("MDB").Range("A" & Rows.Count).End(3)).Value
  For i = 1 To UBound(a, 1)
    dic(a(i, 1)) = Empty
  Next
  ListBox1.List = Application.Transpose(dic.keys)
  
  Erase a
  dic.RemoveAll
  a = Sheets("MDB").Range("C2", Sheets("MDB").Range("C" & Rows.Count).End(3)).Value
  For i = 1 To UBound(a, 1)
    dic(a(i, 1)) = Empty
  Next
  ListBox2.List = Application.Transpose(dic.keys)
End Sub

 

[SamirBhowmik]

Hello @DanteAmor , Your code worked like a magic for populating the unique items in the listboxes (below is the updated screenshot). Now I also need to filter the results with unique values in other listboxes based on a selection on any listbox (either single or multiple). below is the code which populates listbox2 named "Name of Project" based on the selection from listbox1 named "Source". But it does so with the duplicates. I would like to have only the unique items. Could you kindly help?

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim lastRow As Long
Dim selitem As Variant
Dim curval As Variant
'find lastrow
lastRow = Worksheets("MDB").Cells(Rows.Count, 1).End(xlUp).Row

'Clear ListBox

Me.ListBox2.Clear


'not just one value, but whichever were selected

    For selitem = LBound(Me.ListBox1.List) To UBound(Me.ListBox1.List)
    If Me.ListBox1.Selected(selitem) = True Then
        'it is selected
        curval = Me.ListBox1.List(selitem, 0)

        For X = 2 To lastRow
            If Worksheets("MDB").Cells(X, "a") = curval Then
            'found a match; populate ListBox2
            Me.ListBox2.AddItem Worksheets("MDB").Cells(X, "c")
            End If
            
        Next X
    End If
Next selitem


End Sub

 

[DanteAmor]

Now I also need to filter the results with unique values in other listboxes based on a selection on any listbox (either single or multiple). below is the code which populates listbox2 named "Name of Project" based on the selection from listbox1 named "Source".

For that, try this:

Private Sub ListBox1_Change()
  Dim a() As Variant
  Dim dic As Object
  Dim i As Long, j As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("MDB").Range("A2", Sheets("MDB").Range("C" & Rows.Count).End(3)).Value
  
  ListBox2.Clear
  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        For j = 1 To UBound(a, 1)
          If a(j, 1) = .List(i) Then
            dic(a(j, 3)) = Empty
          End If
        Next
      End If
    Next
    If dic.Count > 0 Then ListBox2.List = Application.Transpose(dic.keys)
  End With
End Sub

 

[SamirBhowmik]

Private Sub ListBox1_Change() Dim a() As Variant Dim dic As Object Dim i As Long, j As Long Set dic = CreateObject("Scripting.Dictionary") a = Sheets("MDB").Range("A2", Sheets("MDB").Range("C" & Rows.Count).End(3)).Value ListBox2.Clear With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then For j = 1 To UBound(a, 1) If a(j, 1) = .List(i) Then dic(a(j, 3)) = Empty End If Next End If Next If dic.Count > 0 Then ListBox2.List = Application.Transpose(dic.keys) End With End Sub

Hello @DanteAmor, Thank you once again for the incredible code which works quite well. Could you help me me apply the
same for other listboxes too. I tried adapting it to the listbox3 but I get the same result from the column 3, whereas I want to get the column 2 detail in the listbox 3

Private Sub ListBox1_Change()
  Dim a() As Variant
  Dim dic As Object
  Dim i As Long, j As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  a = Sheets("MDB").Range("A2", Sheets("MDB").Range("M" & Rows.Count).End(3)).Value
 
  ListBox2.Clear
  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        For j = 1 To UBound(a, 1)
          If a(j, 1) = .List(i) Then
            dic(a(j, 3)) = Empty
          End If
        Next
      End If
    Next
    If dic.Count > 0 Then ListBox2.List = Application.Transpose(dic.keys)
  End With
 
  ListBox3.Clear
  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        For j = 1 To UBound(a, 1)
          If a(j, 1) = .List(i) Then
            dic(a(j, 3)) = Empty
          End If
        Next
      End If
    Next
    If dic.Count > 0 Then ListBox3.List = Application.Transpose(dic.keys)
  End With
End Sub

I changed the range to take till the end of the table where I have the data (column M) but I dont know how to change the indexes in the code to adapt it to my listboxes

 

[DanteAmor]

The last 2 requirements do not go according to your original post.
The code in post #2 is the solution to your original post.
You must create a new thread. There he explains in detail the final objective.