Excel macro to show all selections of a multi-select listbox

Question

I would like to create an Excel sheet file with a list box with multi selection as :

item1 
item2
item3
item4
...
..

And then when I select for Example item1 and item3 from that listbox the selected items are populated on another cell with display as

item1 - item 2  are selected 

The solution that I tried is creating multi-select listbox and I attached a macro to it and then I tried to loop on listbox display selected item to a cell but I didn't know to write the Macro, I am not expert on Excel I need to do this.

Thanks in advance

Answer 1

This Should Work Given you are starting with a Fresh No Items Selected ListBox. I choose to add and remove items from the already made string, instead of looping every object every selection/deselection for performance reason. That is an option but this should run much smoother. But if you already have items selected in your ListBox this won't account for them until you deselect then re-select them.

The other difference between this option and looping all values every time, is that with this method it adds the selections/values in order of when they where selected oppose to in the same order as they are in the ListBox, this could be a positive a negative or indifferent to your purpose but figured I should add that in.

Private Sub ListBox1_Change()

Dim lngCurrentItem As Long
Dim strCurrentItem As String
Dim strAllSelectedItems As String
Dim rngOutput As Range

Set rngOutput = [J1]
lngCurrentItem = ListBox1.ListIndex

strAllSelectedItems = rngOutput
strAllSelectedItems = Replace(strAllSelectedItems, " Are Selected", "")
strAllSelectedItems = Replace(strAllSelectedItems, " Is Selected", "")

strCurrentItem = ListBox1.List(lngCurrentItem)

If ListBox1.Selected(lngCurrentItem) Then
    If strAllSelectedItems = "No Items Selected" Then
        rngOutput = strCurrentItem & " Is Selected"
    Else
        rngOutput = strAllSelectedItems & " - " & strCurrentItem & " Are Selected"
    End If
Else
    strAllSelectedItems = Replace(strAllSelectedItems, " - " & strCurrentItem, "")
    strAllSelectedItems = Replace(strAllSelectedItems, strCurrentItem, "")
    If strAllSelectedItems = "" Then
        rngOutput = "No Items Selected"
    ElseIf InStr(1, strAllSelectedItems, " - ", vbTextCompare) > 0 Then
        rngOutput = strAllSelectedItems & " Are Selected"
    Else
        rngOutput = strAllSelectedItems & " Is Selected"
    End If
End If

End Sub

IF you would like to loop the entire list every time (IF you list box is small enough you won't really notice much of a difference in speed, Just make sure your list box isn't set to like an entire Column with over 1 million cells, and you should be fine)

Private Sub ListBox1_Change()

Dim lngCurrentItem As Long
Dim strCurrentItem As String
Dim strAllSelectedItems As String
Dim rngOutput As Range

Set rngOutput = [J1]

strAllSelectedItems = ""

For i = 0 To ListBox1.ListCount - 1
    strCurrentItem = ListBox1.List(i)

    If ListBox1.Selected(i) Then
        If strAllSelectedItems = "" Then
            strAllSelectedItems = strCurrentItem
        Else
            strAllSelectedItems = strAllSelectedItems & " - " & strCurrentItem
        End If
    End If

Next i

If strAllSelectedItems = "" Then
    rngOutput = "No Items Selected"
ElseIf InStr(1, strAllSelectedItems, " - ", vbTextCompare) > 0 Then
    rngOutput = strAllSelectedItems & " Are Selected"
Else
    rngOutput = strAllSelectedItems & " Is Selected"
End If

End Sub