Excel List Multiple selection VBA Code - Deselect

[smartguy]

Hi All,

I am using the below code to use excel list for multiple selections.

if i select again same value i need to remove the value ( Deselect) . can you please help.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
    Dim Newvalue As String

    If Target.Address <> "$E$57" Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    On Error GoTo Exitsub
    If Target.Value = "Multiple List" Then Target.Value = vbNullString
    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 & ", " & Newvalue
        Else
            Target.Value = Oldvalue
        End If
    End If
    Application.EnableEvents = True
    Exit Sub
Exitsub:
    Application.EnableEvents = True

End Sub

 

[John_w]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oldValue As String
    Dim newValue As String
    Dim p1 As Long, p2 As Long

    If Target.Address <> "$E$57" Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Value = "Multiple List" Then Target.Value = vbNullString
    newValue = Target.Value
    Application.Undo
    oldValue = Target.Value
    
    If oldValue = "" Then
        Target.Value = newValue
    Else
        If InStr(1, oldValue, newValue) = 0 Then
            'Append new value
            Target.Value = oldValue & ", " & newValue
        Else
            'Remove already selected value
            p1 = InStr(", " & oldValue & ", ", ", " & newValue & ", ")
            p2 = p1 + Len(", " & newValue & ", ")
            If p1 = 1 Then
                'Remove from start
                oldValue = Mid(oldValue, p2 - 2)
            ElseIf p1 + Len(", " & newValue & ", ") = Len(", " & oldValue & ", ") + 1 Then
                'Remove from end
                oldValue = Left(oldValue, p1 - 3)
            ElseIf p1 > 1 Then
                'Remove from middle
                oldValue = Left(oldValue, p1 - 1) & Mid(oldValue, p2 - 2)
            End If
            Target.Value = oldValue
        End If
    End If
    
    Application.EnableEvents = True

End Sub