Unable to remove drop down selection values from a cell

S

S0ph1e

New Member
Joined
Dec 13, 2023
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hi!

I have used the below VBA code so i can make multiple sections within a cell from a drop down list. This was all working fine and i could easily delete any section i made, but now i can't. When i select an option and then try and delete it form the cell by pressing delete or backspace, it doesn't remove it. Does anyone know why? Not sure if i need to change the code or not...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("N:N,M:M")) Is Nothing Then
  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:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
 
Last edited by a moderator:

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
You could use something like this, which will allow you to delete an item by just selecting it again from the validation list:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Const SEPARATOR As String = ", "
   Dim Oldvalue As String
   Dim Newvalue As String
   On Error GoTo Exitsub
   If Not Intersect(Target, Range("N:N,M:M")) Is Nothing Then
      If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
         If Target.Value <> "" Then
            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 & SEPARATOR & Newvalue
               Else
                  Dim parts() As String
                  parts = Split(Oldvalue, SEPARATOR)
                  Dim n As Long
                  For n = LBound(parts) To UBound(parts)
                     If parts(n) = Newvalue Then
                        parts(n) = "|#|"
                        Exit For
                     End If
                  Next n
                  Target.Value = Join(Filter(parts, "|#|", False), SEPARATOR)
               End If
            End If
         End If
      End If
   End If
Exitsub:
   Application.EnableEvents = True
End Sub
 
Upvote 0
Glad we could help. :)
 
Upvote 0
RoryA said:
Glad we could help. :)
Click to expand...
Sorry to come back to this issue, but I've just opened up the spread sheet and for some reason I can no longer add multiple selections to the cell, and it no longer deletes the value when I select it again! I did make a slight change to the code to prevent an error message when adding a new row, but I did a check after changing it and it still worked perfectly fine up until now! Do you have any idea what the issue might be? Below is the full code within Sheet 1 of my VBA.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Const SEPARATOR As String = ", "
   Dim Oldvalue As String
   Dim Newvalue As String
   On Error GoTo Exitsub
   If Not Intersect(Target, Range("N:N,M:M")) Is Nothing Then
      If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
          If Target.CountLarge > 1 Then Exit Sub
            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 & SEPARATOR & Newvalue
               Else
                  Dim parts() As String
                  parts = Split(Oldvalue, SEPARATOR)
                  Dim n As Long
                  For n = LBound(parts) To UBound(parts)
                     If parts(n) = Newvalue Then
                        parts(n) = "|#|"
                        Exit For
                     End If
                  Next n
                  Target.Value = Join(Filter(parts, "|#|", False), SEPARATOR)
               End If
            End If
         End If
      End If
Exitsub:
   Application.EnableEvents = True



Dim myTableRange As Range
Dim myUpdateRange As Range

Set myTableRange = Range("A4:AD1000")

If Intersect(Target, myTableRange) Is Nothing Then Exit Sub

Set myUpdateRange = Range("AE" & Target.Row)

myUpdateRange.Value = Now



End Sub
 
Upvote 0
Try changing it to:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Const SEPARATOR As String = ", "
   Dim Oldvalue As String
   Dim Newvalue As String
   On Error GoTo Exitsub
   If Not Intersect(Target, Range("N:N,M:M")) Is Nothing Then
      If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
          If Target.CountLarge > 1 Then Exit Sub
            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 & SEPARATOR & Newvalue
               Else
                  Dim parts() As String
                  parts = Split(Oldvalue, SEPARATOR)
                  Dim n As Long
                  For n = LBound(parts) To UBound(parts)
                     If parts(n) = Newvalue Then
                        parts(n) = "|#|"
                        Exit For
                     End If
                  Next n
                  Target.Value = Join(Filter(parts, "|#|", False), SEPARATOR)
               End If
            End If
         End If
      End If



Dim myTableRange As Range
Set myTableRange = Range("A4:AD1000")

If Not Intersect(Target, myTableRange) Is Nothing Then Range("AE" & Target.Row).Value = Now

Exitsub:
   Application.EnableEvents = True


End Sub
 
Upvote 0
RoryA said:
Try changing it to:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Const SEPARATOR As String = ", "
   Dim Oldvalue As String
   Dim Newvalue As String
   On Error GoTo Exitsub
   If Not Intersect(Target, Range("N:N,M:M")) Is Nothing Then
      If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
          If Target.CountLarge > 1 Then Exit Sub
            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 & SEPARATOR & Newvalue
               Else
                  Dim parts() As String
                  parts = Split(Oldvalue, SEPARATOR)
                  Dim n As Long
                  For n = LBound(parts) To UBound(parts)
                     If parts(n) = Newvalue Then
                        parts(n) = "|#|"
                        Exit For
                     End If
                  Next n
                  Target.Value = Join(Filter(parts, "|#|", False), SEPARATOR)
               End If
            End If
         End If
      End If



Dim myTableRange As Range
Set myTableRange = Range("A4:AD1000")

If Not Intersect(Target, myTableRange) Is Nothing Then Range("AE" & Target.Row).Value = Now

Exitsub:
   Application.EnableEvents = True


End Sub
Click to expand...
That's worked. A little confused why it didn't stop working when I made the changes.. So i need to make sure the 'Exitsub:
Application.EnableEvents = True' is at the end just before the end sub... Thank you :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
I have code that works for creating a drop-down list on a WORKSHEET that allows you to select multiple items... can this also be done on a USERFORM?
Replies
2
Views
166
kbishop94
K
S
  • Question
Add Deselect VBA Coding for Multiselect Dropdown
Replies
1
Views
1K
John_w
J
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
377
sspatriots
S
D
  • Question
Excel and VB scripts
Replies
0
Views
402
DazzaL
D
D
  • Question
how to create a drop down list in excel with multiple selections for entire column?
Replies
2
Views
802
Akuini
Akuini

Forum statistics

Threads
1,215,073
Messages
6,122,976
Members
449,095
Latest member
Mr Hughes

Share this page

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
Back
Top