CODEWITHSUNDEEP
excelvbacomboboxlistboxunique
Renier Wessels
Renier Wessels

Reputation: 151

VBA Unique values in Combobox list from Listbox column / field

I am looking to make a Combobox list only the unique values in a Listbox field / column every time the listbox's list changes.

For example column 3 in the listbox contains multiple instances of Apple, Strawberry and Banana. I want the combobox to contain only Apple, Strawberry and Banana once each.

Any elegant ideas?

Upvotes: 0

Views: 462

Answers (3)

T.M.
T.M.

Reputation: 9948

Assign unique 3rd column items to Combobox

  • [1] There are several ways to receive uniques (dictionary, arraylist); I demonstrate an approach using FilterXML() function (available since vers. 2013+) as well as a tricky way to isolate the 3rd listbox column by the listbox'es .Column property via arr = Application.Index(Me.ListBox1.Column, 3, 0), thus receiving a "flat" array without loops,
  • [2] create a simple wellformed xml structure based on the array data and provide for an XPath search string to get uniques and
  • [3] assign the "vertical" 2-dim uniques received via FilterXML() to the combobox'es .List property. Furthermore I added a small error handler providing for the case of a single item.
Private Sub ListBox1_Change()
    If Me.ListBox1.ListCount = 0 Then Exit Sub              ' Escape if no list items available
    With Application
        '[1] get 3rd column items of listbox
        Dim arr: arr = .Index(Me.ListBox1.Column, 3, 0)     ' Index uses 1-based indices

        '[2] create FilterXML arguments to get uniques
        Dim XContent As String: XContent = "<t><s>" & Join(arr, "</s><s>") & "</s></t>"
        Dim XP As String: XP = "//s[not(preceding::*=.)]"   ' XPath expression searching uniques
        '[3] assign "vertical" 2-dim uniques to combobox
        Dim uniques: uniques = .FilterXML(XContent, XP)     ' get uniques to combobox
        On Error Resume Next:  Me.ComboBox1.List = uniques  ' assign uniques to combobox
        If Err.Number <> 0 Then Me.ComboBox1.AddItem uniques
    End With
End Sub

Upvotes: 1

Harun24hr
Harun24hr

Reputation: 37125

Try below codes and let us know your feedback.

Private Sub ListBox1_Change()
    Dim dict As Object
    Dim i As Long

    Set dict = CreateObject("Scripting.Dictionary")
        For i = 0 To ListBox1.ListCount - 1
            dict.Item(ListBox1.List(i)) = vbNullString
        Next i
    ComboBox1.List = dict.keys
    Set dict = Nothing
End Sub

Upvotes: 0

GWD
GWD

Reputation: 4048

Removing duplicates from a list can be achieved using a dictionary. For the following code to work, you have to add "Microsoft Scripting Runtime" to your references.

Private Sub ListBox1_Change()
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary
    Dim i As Long
    On Error Resume Next
    For i = 0 To ListBox1.ListCount - 1
        dict.Add Key:=ListBox1.List(i), Item:=0
    Next i
    ComboBox1.List = dict.Keys
End Sub

I haven't had the opportunity to test it, let me know if it works.

Upvotes: 1

Related Questions