VBA: Multi-select Listbox to a single cell but without duplicates

August 24, 2022

I haven’t used VBA in about 10 years until needing it this week, so my recall is not that great right now – appreciate any advice you are able to give!

I have a User form where there is a multiple selection listbox option that inserts the selected items into a single cell separated by a comma. The list referenced for the listbox has 2 columns – a GROUP and a PROJECT name.

Multiple projects can fall under the same group. I have the group column going to one cell and the project to another, but if users multi-select projects from the same group they will get the same group name repeated.

How can I adjust this to allow the group name to only appear once in a cell?

Adding grouping to Excel sheet:

For X = 0 To Me.listbox_group.ListCount - 1
   If Me.listbox_group.Selected(x) Then
      If varGroup = "" Then
         varGroup = Me.listbox_group.List (x,0)
      Else
         varGroup = varGroup & ", " & Me.listbox_group.List(x,0)
      End If
   End If
 Next x

Specifying cell location for the selection to go to:

Sheets("Data").Range("Data_Start").Offset(TargetRow, 0).Value = UCase(varGroup)

>Solution :

In order to get only unique values you could use a dictionary

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")


    For x = 0 To Me.listbox_group.ListCount - 1
        If Me.listbox_group.Selected(x) Then
            dict(listbox_group.List(x, 0)) = listbox_group.List(x, 0)
'            If varGroup = "" Then
'                varGroup = Me.listbox_group.List(x, 0)
'            Else
'                varGroup = varGroup & ", " & Me.listbox_group.List(x, 0)
'            End If
        End If
    Next x
     

    Dim s As Variant
    s = Join(dict.Keys, ",")
    
    Sheets("Data").Range("Data_Start").Offset(TargetRow, 0).Value = UCase(s)

I only assign values because there is a kind of extra feature: If the Key does not exist it automatically adds the Key and Item to the dictionary.

Upper ander lower case pitfall: The above code will a consider groups with the name G1 and g1 as different. If you do not want that use

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")


    For x = 0 To Me.listbox_group.ListCount - 1
        If Me.listbox_group.Selected(x) Then
            Dim selElement As String
            selElement = UCase(listbox_group.List(x, 0))
            dict(selElement) = selElement
'            If varGroup = "" Then
'                varGroup = Me.listbox_group.List(x, 0)
'            Else
'                varGroup = varGroup & ", " & Me.listbox_group.List(x, 0)
'            End If
        End If
    Next x

    Dim s As Variant
    s = Join(dict.Keys, ",")

   Sheets("Data").Range("Data_Start").Offset(TargetRow, 0).Value = s