Forum Discussion
Multi drop down list macro code doesn't delete values in cell
I tried to be too clever. Here is the version I originally wrote...
Private Sub Worksheet_Change(ByVal Target As Range) Dim OldValue As String Dim NewValue As String Dim TempOld As String Dim TempNew As String If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("L:O")) Is Nothing 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 NewValue = Target.Value Application.Undo OldValue = Target.Value If OldValue = "" Then Target.Value = NewValue Else TempOld = ", " & OldValue & ", " TempNew = ", " & NewValue & ", " If InStr(TempOld, TempNew) = 0 Then Target.Value = OldValue & ", " & NewValue Else TempOld = Replace(TempOld, TempNew, ", ") If Left(TempOld, 2) = ", " Then TempOld = Mid(TempOld, 3) End If If Right(TempOld, 2) = ", " Then TempOld = Left(TempOld, Len(TempOld) - 2) End If Target.Value = TempOld End If End If Exitsub: Application.EnableEvents = True End Sub
That is to be expected, since "LATAM, Central America" is not in the data validation list.
You'd have to clear the cell completely, then select the values you want to keep.
Here is an alternative. You still won't be able to remove a value by editing the cell directly. But you'll be able to do so by selecting the value you want to remove from the dropdown list.
In other words: the first time you select "Caribbean", it will be added to the cell value. The second time you select it, it will be removed from the cell value.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("L:O")) Is Nothing 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
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
ElseIf InStr(Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else
Target.Value = Join(Filter(Split(Oldvalue, ", "), Newvalue, False), ", ")
End If
Exitsub:
Application.EnableEvents = True
End Sub
Hey hi HansVogelaar
Thanks a lot, much better solution.
I just have a problem, when there are 2 values that are very similar to each other but I just want to remove one of them it will delete me both.
For example, in the column O I want to select both "technical" and "technical operations":
After selecting "technical operations" for example:
When I proceed selecting "technical" from the dropdown list, it will delete me "Technical Operations"
Any idea how to fix this in the code?
Thanks!
I tried to be too clever. Here is the version I originally wrote...
Private Sub Worksheet_Change(ByVal Target As Range) Dim OldValue As String Dim NewValue As String Dim TempOld As String Dim TempNew As String If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("L:O")) Is Nothing 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 NewValue = Target.Value Application.Undo OldValue = Target.Value If OldValue = "" Then Target.Value = NewValue Else TempOld = ", " & OldValue & ", " TempNew = ", " & NewValue & ", " If InStr(TempOld, TempNew) = 0 Then Target.Value = OldValue & ", " & NewValue Else TempOld = Replace(TempOld, TempNew, ", ") If Left(TempOld, 2) = ", " Then TempOld = Mid(TempOld, 3) End If If Right(TempOld, 2) = ", " Then TempOld = Left(TempOld, Len(TempOld) - 2) End If Target.Value = TempOld End If End If Exitsub: Application.EnableEvents = True End Sub