Deselect from Multiselect Dropdown (with vbNewLine)

[GHVDS]

Hi all,

I am trying to understand VBA as I am working on my document. I am getting stuck at the following issue:

For two cells (D43 and D56)I want to be able to deselect values from a multi-select dropdown which presents each value below the other. My current code is as following (without deselect):

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("D56", "D43")) 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 & vbNewLine & Newvalue
            Else:
                Target.Value = Oldvalue
            End If
        End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

How do I introduce the deselect function in here? Your help is much appreciated!

 

[John_w]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OldValue As String
    Dim NewValue As String
    Dim p1 As Long, p2 As Long

    If Intersect(Target, Range("D56", "D43")) Is Nothing Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    
    NewValue = Target.Value
    Application.Undo
    OldValue = Target.Value
    
    If OldValue = "" Then
        Target.Value = NewValue
    Else
        p1 = InStr(vbNewLine & OldValue & vbNewLine, vbNewLine & NewValue & vbNewLine)
        If p1 = 0 Then
            'Append new value
            Target.Value = OldValue & vbNewLine & NewValue
        Else
            'Remove already selected value
            p2 = p1 + Len(vbNewLine & NewValue & vbNewLine)
            If p1 = 1 Then
                'Remove from start
                OldValue = Mid(OldValue, p2 - 2)
            ElseIf p2 = Len(vbNewLine & OldValue & vbNewLine) + 1 Then
                'Remove from end
                OldValue = Left(OldValue, p1 - 3)
            ElseIf p1 > 1 Then
                'Remove from middle
                OldValue = Left(OldValue, p1 - 1) & Mid(OldValue, p2 - 2)
            End If
            Target.Value = OldValue
        End If
    End If
    
    Application.EnableEvents = True

End Sub

Notice that both InStr arguments are surrounded with vbNewLine characters to ensure that the correct value is found when deselecting a value. The p1 and p2 arguments in the subsequent Mid and Left functions account for the extra vbNewLines. Without this, if the dropdown list contained Bobby and Bob in that order and you select Bob to deselect it then Bobby would be removed instead.

 

[GHVDS]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OldValue As String
    Dim NewValue As String
    Dim p1 As Long, p2 As Long

    If Intersect(Target, Range("D56", "D43")) Is Nothing Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
   
    Application.EnableEvents = False
   
    NewValue = Target.Value
    Application.Undo
    OldValue = Target.Value
   
    If OldValue = "" Then
        Target.Value = NewValue
    Else
        p1 = InStr(vbNewLine & OldValue & vbNewLine, vbNewLine & NewValue & vbNewLine)
        If p1 = 0 Then
            'Append new value
            Target.Value = OldValue & vbNewLine & NewValue
        Else
            'Remove already selected value
            p2 = p1 + Len(vbNewLine & NewValue & vbNewLine)
            If p1 = 1 Then
                'Remove from start
                OldValue = Mid(OldValue, p2 - 2)
            ElseIf p2 = Len(vbNewLine & OldValue & vbNewLine) + 1 Then
                'Remove from end
                OldValue = Left(OldValue, p1 - 3)
            ElseIf p1 > 1 Then
                'Remove from middle
                OldValue = Left(OldValue, p1 - 1) & Mid(OldValue, p2 - 2)
            End If
            Target.Value = OldValue
        End If
    End If
   
    Application.EnableEvents = True

End Sub

Notice that both InStr arguments are surrounded with vbNewLine characters to ensure that the correct value is found when deselecting a value. The p1 and p2 arguments in the subsequent Mid and Left functions account for the extra vbNewLines. Without this, if the dropdown list contained Bobby and Bob in that order and you select Bob to deselect it then Bobby would be removed instead.

Hi John,

Thank you so much for this answer. This solves my question beautifully. You have saved me from many frustrating hours!