Forum Discussion
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 of them like this:
From:
To:
After I hit enter, I will get a pop up error saying:
Can you please let help me fix my code below:
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("L:O")) 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
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
4 Replies
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 SubHey 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
