Excel VBA multi select drop down list

Question

I am trying to create a multi select dropdown list with Excel VBA. I have the following code for Sheet1.

With Range("B27").Validation
    .Delete
End With

With Range("B27")
    .Value = "[Select from drop down]"
End With

With Range("B27").Validation
     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Formula1:="=DropDownList_data!D1:D3")
     .IgnoreBlank = True
End With

Cells D1, D2 and D3 in the DropDownList_data tab contain the text Item1,Item2,Item3 respectively. I have made this a multi select list by writing code in the Worksheet_Change event. When I select the 3 items consecutively, Item1,Item2,Item3 appears in Cell B27. However, when I manually delete ,Item3 from the cell the following error appears. "This value doesn't match the data validation restrictions defined for this cell."

The following is the code in the Worksheet_Change event.

Dim Newvalue, Oldvalue As String


    On Error GoTo Exitsub

    Application.EnableEvents = False


   If Target.Address="$B$27" Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
            Else: If Target.Value = "" Then GoTo Exitsub Else
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Or Oldvalue = "[Select from drop down]" Then
                Target.Value = Newvalue
            Else
                Dim strArray() As String
                strArray = Split(Oldvalue, ",")
                If IsInArray(Newvalue, strArray) Then
                    Target.Value = Oldvalue
                Else
                    Target.Value = Oldvalue & "," & Newvalue
                End If
            End If
        End If
    End If
Exitsub:
    Application.EnableEvents = True

How can I manually delete an item after I have selected it?

A drop down validation list cannot accept multiple selections. Of course, there are some tricks to concatenate the existing selection with the new one, but this is good to be done in another cell, not in the one with list validation. If you would edit your question and you will also post the Worksheet_Change event code, you maybe will receive an answer. Otherwise, nobody is able to understand what "when I manually delete ,Item3 from the cell the following error appears" means. I can only suppose. The cell validation means exactly that it admits only selecting elements from the list. — FaneDuru

Tim Williams Tim Williams · Accepted Answer · 2020-12-09T01:49:17

The trick when doing this type of thing is you can't manually edit the cell content and try to remove part of the list of selections, unless you're leaving an empty cell or a single value from the list.

The typical approach to remove a value you already selected is to select it again from the list and have the event handler remove it from the list in the cell.

Private Sub Worksheet_Change(ByVal Target As Range)

    ' To allow multiple selections in a Drop Down List
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim rng As Range, srcRange As Range, arr, listVals
    
    'run some checks
    Set rng = Application.Intersect(Target, Me.Range("B27"))
    If rng Is Nothing Then Exit Sub
    
    Newvalue = rng.Value
    If Len(Newvalue) = 0 Then Exit Sub
    
    If rng.Value <> "" Then
        On Error GoTo Exitsub
        Application.EnableEvents = False
        Application.Undo
        Oldvalue = rng.Value
        If Oldvalue = "" Then
            rng.Value = Newvalue
        Else
            listVals = Application.Evaluate(rng.Validation.Formula1).Value
            rng.Value = SortItOut(listVals, Oldvalue, Newvalue) '<< call function
        End If
    End If
    
Exitsub:
    If Err.Number > 0 Then Debug.Print Err.Description
    Application.EnableEvents = True
End Sub

Private Function SortItOut(listVals, oldVal, newVal)
    Const LIST_SEP As String = ", "
    Dim i As Long, arr, s, sep, t, listed, removeNewVal
    s = ""
    sep = ""
    arr = Split(oldVal, LIST_SEP)
    'new value already listed?
    removeNewVal = Not IsError(Application.Match(newVal, arr, 0))
    
    For i = 1 To UBound(listVals, 1)
        t = listVals(i, 1)
        listed = Not IsError(Application.Match(t, arr, 0))
        If listed Or newVal = t Then
            If Not (removeNewVal And newVal = t) Then
                s = s & sep & t
                sep = LIST_SEP
            End If
        End If
    Next i
    
    SortItOut = s
End Function

Excel VBA multi select drop down list

1 Answers