Excel Multiselect Without Closing

Question

I want to create an excel multiselect without the box closing everytime you select an item. I have built out the solution posted here regarding the excel and VBA:

https://trumpexcel.com/select-multiple-items-drop-down-list-excel/

But want a more user friendly approach that the box wont close until I click away - just like how it is with normal application.

How can I build this out? Appreciate the help

Answer 1

Here's a basic example using an ActiveX listbox placed on the worksheet and named lstMulti (set the control's multiselect property to 1)

It will show the listbox over a cell when the cell is double-clicked. When clicking away from the cell it will update the cell with any changes in the selections.

In the worksheet code module:

Option Explicit

Const RNG_LIST_FILL As String = "J1:J10"    'or wherever your list of values is
Const RNG_MULTI As String = "A2:A10"        'multi-select appears in this range on double-click
Const VAL_SEP As String = "|"               'cell value separator
Dim currCell As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim lb As Object, v, arr, i As Long
    Set lb = Me.lstMulti
    Debug.Print "double-click     ", Target.Address
    If Not Application.Intersect(Me.Range(RNG_MULTI), Target) Is Nothing Then
        lb.Visible = True        'show, position and size, and fill the listbox
        lb.Width = Target.Width
        lb.Height = 200
        lb.Top = Target.Top
        lb.Left = Target.Left
        lb.ListFillRange = "J1:J10"
        v = Target.Value
        If Len(v) > 0 Then  'any existing values?
            arr = Split(v, VAL_SEP)
            For i = 0 To lb.ListCount - 1
                'select any previously-selected values
                If Not IsError(Application.Match(lb.List(i), arr, 0)) Then
                    lb.Selected(i) = True
               End If
            Next i
        End If
        Set currCell = Target 'remember where we showed the list
        Cancel = True         'don't enter cell edit mode
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lb As Object, i As Long, sep As String, s As String
    
    Set lb = Me.lstMulti
    Debug.Print "selection changed", Target.Address
    If Not currCell Is Nothing Then 'any previously-selected cell?
        s = ""
        For i = 0 To lb.ListCount - 1
            If lb.Selected(i) Then
                s = s & sep & lb.List(i) 'build a string of any selected values
                sep = VAL_SEP
            End If
        Next i
        currCell.Value = s       'populate the list to the cell
        Set currCell = Nothing   'clear the current cell varaible
    End If
    lb.Visible = False           'hide the listbox
End Sub