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

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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
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

D
  • Question Question
Make the code work in a protected sheet
Replies
7
Views
195
dmt32
D
M
  • Solved
Trying to apply 2 Worksheet Changes
Replies
1
Views
235
Joe4
Joe4
H
  • Question Question
Using VBA to select multiple criteria in 2 dropdown lists on the same sheet
Replies
1
Views
429
My Aswer Is This
My Aswer Is This
D
  • Solved
VBA to deselect a single value in a multi-selection drop down list.
Replies
1
Views
856
smozgur
smozgur
welshraz
  • Question Question
VBA - Restrict Code to One Column for Multi-choice Dropdown
Replies
2
Views
130
welshraz
welshraz

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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