Deselect from Multiselect Dropdown / with vbNewLine / for 2 columns

[KrissKross]

I am new to vba, and for two columns I am trying to create a multi-select drop down lists using with vbNewLine (rather than being separated by a comma), but now I want to add in the capability to "deselect" items. This is my current code, as I do not know how to add in the "deselect" code part.

Please help

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from Online Excel Tips & Tutorials
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 1 Or Target.Column = 2 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
ElseIf Target.Value = "" Then
GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

 

[sijpie]

Hi KrissKross, welcome. Please next time you post code, post it between code brackets: click on the littel vba icon above the pst area, and paste your code.

The below should do the trick

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from Online Excel Tips & Tutorials
' To allow multiple selections in a Drop Down List in Excel (without repetition)
    Dim Oldvalue As String
    Dim Newvalue As String
    
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Column = 1 Or Target.Column = 2 Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        ElseIf Target.Value = "" Then
            GoTo Exitsub
        Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If "*" & Newvalue & "*" Like Oldvalue Then
                    'existing string already contains selected value, so remove
                    Oldvalue = Replace(Oldvalue, Newvalue, "")
                    'remove any double new lines, if replaced value was not first or last item
                    Oldvalue = Replace(Oldvalue, vbNewLine & vbNewLine, vbNewLine)
                Else
                    'Existing string does not contain seleted value, so add
                    Oldvalue = Oldvalue & vbNewLine & Newvalue
                End If
            End If
        End If
    End If
Exitsub:
    Application.EnableEvents = True
    On Error GoTo 0     'reset error behaviour
End Sub

 

[sijpie]

Just some extra remarks: You had used the Instr() function to check if the item is there. But the like operator is a lot faster. I append * on either end of the string to be found, as it works with wildcards.

In order to do (either method) it completely correctly you would need to also check for vbnewline on both ends of the word with additional exeptions for the first or the last item, to accommodate for partial words: If your selection lists included things like "strawberry, cherry, berry, blackberry" and the user selected berry, where he had earlier already selected strawberry, then it would show "straw" instead of "strawberry, berry"