Deselecting an item in a multiselect dropdown list

BRYCEPIETROWIAK

New Member
Joined
May 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,067
Office Version
  1. 365
  2. 2010
Code:
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

New Member
Joined
May 12, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Code:
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.
 

Attachments

  • Excel Help 1.JPG
    Excel Help 1.JPG
    90.7 KB · Views: 3
  • Excel Help 2.JPG
    Excel Help 2.JPG
    23.3 KB · Views: 3

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,067
Office Version
  1. 365
  2. 2010
Did you put the code in the SHEET rather than a module?
 

kweaver

Well-known Member
Joined
May 8, 2018
Messages
2,067
Office Version
  1. 365
  2. 2010
Unsure what the problem is as it works for me.
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,903
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.
VBA Code:
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
 

Forum statistics

Threads
1,136,864
Messages
5,678,216
Members
419,752
Latest member
TryingtoLearnVBA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top