SOLVED

Multi drop down list macro code doesn't delete values in cell

Brass Contributor

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:

diego9010_1-1704646800623.png

 

To:

 

diego9010_2-1704646824700.png

 

After I hit enter, I will get a pop up error saying: 

 

diego9010_0-1704646763566.png

 

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!

 

 

 

4 Replies

@diego9010 

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":

 

diego9010_0-1704657883934.png

 

 

After selecting "technical operations" for example: 

diego9010_1-1704657916506.png

 

 

When I proceed selecting "technical" from the dropdown list, it will delete me "Technical Operations"

 

diego9010_2-1704657980898.png

 

 

Any idea how to fix this in the code?

 

Thanks!

 

best response confirmed by diego9010 (Brass Contributor)
Solution

@diego9010 

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
You rock @HansVogelaar

Thanks a mill for your help!
1 best response

Accepted Solutions
best response confirmed by diego9010 (Brass Contributor)
Solution

@diego9010 

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

View solution in original post