Deselect from Multiselect Dropdown / with vbNewLine / for 2 columns

KrissKross

New Member
Joined
Apr 5, 2023
Messages
1
Office Version
  1. 2010
I am new to vba, and for two columns I am trying to create a multi-select drop down lists using with vbNewLine (rather than being separated by a comma), but now I want to add in the capability to "deselect" items. This is my current code, as I do not know how to add in the "deselect" code part.

Please help :)

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from Online Excel Tips & Tutorials
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 1 Or Target.Column = 2 Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
ElseIf 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
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Hi KrissKross, welcome. Please next time you post code, post it between code brackets: click on the littel vba icon above the pst area, and paste your code.

The below should do the trick

VBA Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Code by Sumit Bansal from Online Excel Tips & Tutorials
' To allow multiple selections in a Drop Down List in Excel (without repetition)
    Dim Oldvalue As String
    Dim Newvalue As String
    
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Column = 1 Or Target.Column = 2 Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        ElseIf 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 "*" & Newvalue & "*" Like Oldvalue Then
                    'existing string already contains selected value, so remove
                    Oldvalue = Replace(Oldvalue, Newvalue, "")
                    'remove any double new lines, if replaced value was not first or last item
                    Oldvalue = Replace(Oldvalue, vbNewLine & vbNewLine, vbNewLine)
                Else
                    'Existing string does not contain seleted value, so add
                    Oldvalue = Oldvalue & vbNewLine & Newvalue
                End If
            End If
        End If
    End If
Exitsub:
    Application.EnableEvents = True
    On Error GoTo 0     'reset error behaviour
End Sub
 
Upvote 0
Just some extra remarks: You had used the Instr() function to check if the item is there. But the like operator is a lot faster. I append * on either end of the string to be found, as it works with wildcards.

In order to do (either method) it completely correctly you would need to also check for vbnewline on both ends of the word with additional exeptions for the first or the last item, to accommodate for partial words: If your selection lists included things like "strawberry, cherry, berry, blackberry" and the user selected berry, where he had earlier already selected strawberry, then it would show "straw" instead of "strawberry, berry"
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top