Deselecting an item in a multiselect dropdown list

[BRYCEPIETROWIAK]

Hello,

I created a multi-select drop down list in my Excel sheet, but now I am unable to deselect my options. If I make a mistake and choose the wrong option, I am unable to remove that selection without having the delete the entire cell. Can anyone help to update my VBA code??

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2019/11/13
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
If Target.Count > 1 Then Exit Sub
On Error Resume Next
Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
If xRng Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not Application.Intersect(Target, xRng) Is Nothing Then
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or _
InStr(1, xValue1, ", " & xValue2) Or _
InStr(1, xValue1, xValue2 & ",") Then
Target.Value = xValue1
Else
Target.Value = xValue1 & ", " & xValue2
End If
End If
End If
End If
Application.EnableEvents = True
End Sub

 

[kweaver]

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal
' To allow multiple selections in a Drop Down List in Excel (without repetition) and deselection
Dim Sp As Variant, n As Long, nstr As String
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 3 Then   ' drop down in C column if using 3
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If 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 & "; " & Newvalue
      Else:
        Sp = Split(Target.Value, "; ")
            For n = 0 To UBound(Sp)
                If Not Sp(n) = Newvalue Then
                    nstr = nstr & IIf(nstr = "", Sp(n), "; " & Sp(n))
                End If
            Next n
            Target.Value = nstr: nstr = ""
            'Target.Value = Oldvalue
        End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

 

[BRYCEPIETROWIAK]

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal
' To allow multiple selections in a Drop Down List in Excel (without repetition) and deselection
Dim Sp As Variant, n As Long, nstr As String
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 3 Then   ' drop down in C column if using 3
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If 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 & "; " & Newvalue
      Else:
        Sp = Split(Target.Value, "; ")
            For n = 0 To UBound(Sp)
                If Not Sp(n) = Newvalue Then
                    nstr = nstr & IIf(nstr = "", Sp(n), "; " & Sp(n))
                End If
            Next n
            Target.Value = nstr: nstr = ""
            'Target.Value = Oldvalue
        End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Hello, I just tried this code, but now I can only select one option from my sheet. The deselecting also did not work for me Also, when I was previously able to multi-select from the drop down, I would get this small error and I am not sure why.

 

[kweaver]

Did you put the code in the SHEET rather than a module?

 

[BRYCEPIETROWIAK]

Did you put the code in the SHEET rather than a module?

Yes I do

 

[kweaver]

Unsure what the problem is as it works for me.

 

[John_w]

I created a multi-select drop down list in my Excel sheet, but now I am unable to deselect my options. If I make a mistake and choose the wrong option, I am unable to remove that selection without having the delete the entire cell. Can anyone help to update my VBA code??

Is the code designed to deselect an item? I can't see how.

Try this, which adds an item if it isn't already selected and removes it if it's already selected.

Const sep = ", "

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2019/11/13
    Dim xRng As Range
    Dim oldVal As String
    Dim newVal As String
    Dim p As Long
    Dim parts As Variant
    
    If Target.Count > 1 Then Exit Sub
    
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo 0
    If xRng Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If oldVal <> "" Then
            If newVal <> "" Then
                p = InStrRev(sep & oldVal & sep, sep & newVal & sep)
                If p = 0 Then
                    Target.Value = oldVal & sep & newVal
                Else
                    parts = Split(sep & oldVal & sep, sep & newVal & sep)
                    If parts(0) & parts(1) = "" Then
                        Target.Value = ""
                    ElseIf parts(0) = "" Then
                        Target.Value = Left(parts(1), Len(parts(1)) - Len(sep))
                    ElseIf parts(1) = "" Then
                        Target.Value = Mid(parts(0), Len(sep) + 1)
                    Else
                        Target.Value = Mid(parts(0), Len(sep) + 1) & sep & Left(parts(1), Len(parts(1)) - Len(sep))
                    End If
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
    
End Sub

 

[carmsedu]

Is the code designed to deselect an item? I can't see how.

Try this, which adds an item if it isn't already selected and removes it if it's already selected.

Const sep = ", "

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 2019/11/13
    Dim xRng As Range
    Dim oldVal As String
    Dim newVal As String
    Dim p As Long
    Dim parts As Variant
   
    If Target.Count > 1 Then Exit Sub
   
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo 0
    If xRng Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If oldVal <> "" Then
            If newVal <> "" Then
                p = InStrRev(sep & oldVal & sep, sep & newVal & sep)
                If p = 0 Then
                    Target.Value = oldVal & sep & newVal
                Else
                    parts = Split(sep & oldVal & sep, sep & newVal & sep)
                    If parts(0) & parts(1) = "" Then
                        Target.Value = ""
                    ElseIf parts(0) = "" Then
                        Target.Value = Left(parts(1), Len(parts(1)) - Len(sep))
                    ElseIf parts(1) = "" Then
                        Target.Value = Mid(parts(0), Len(sep) + 1)
                    Else
                        Target.Value = Mid(parts(0), Len(sep) + 1) & sep & Left(parts(1), Len(parts(1)) - Len(sep))
                    End If
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
   
End Sub

John W, I registered on here just to say "Thank You". I've spent at least 5-6 hours pouring over different YouTube videos and other websites that claimed to work that haven't. I've typed and retyped code but to no avail.

Finally, I came upon this thread, your post, and your code, and it works like a charm. You've made my week. Thank you.