Adding unique items in listboxes

SamirBhowmik

New Member
Joined
Sep 23, 2021
Messages
26
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
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 : (

VBA Code:
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
 

Attachments

  • Capture.JPG
    Capture.JPG
    107.5 KB · Views: 7

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows
In your image I don't see a listbox. Do you mean listbox or combobox?


Try this:

VBA Code:
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
 
Solution

SamirBhowmik

New Member
Joined
Sep 23, 2021
Messages
26
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
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?

VBA Code:
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
 

Attachments

  • Capture 2 listbox.JPG
    Capture 2 listbox.JPG
    92 KB · Views: 7

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows
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:

VBA Code:
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

New Member
Joined
Sep 23, 2021
Messages
26
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
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
VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
13,908
Office Version
  1. 2007
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,147,482
Messages
5,741,409
Members
423,657
Latest member
Medrok2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top