Forum Discussion
Solved
Multi drop down list macro code doesn't delete values in cell
Hi all I have the a VBA code that allows a multi drop down list in some columns. It works well but the problem is that when I select multiple values in the same cell and then I want to delete 1 o...
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
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