[Solved] Multiple Selections for Drop Down Menu

[RW33]

Hello,
I am developing an excel spreadsheet to track some data, and I found the below code to select multiple options in a drop down menu. This works great, in the column (12) that it is intended to work in.

However, I have a second column that I need to be able to make multiple selections on a drop down menu in, but this menu is using a different list than the original (12) column. Is anyone able to help me with the below code so that it will allow me to make multiple selections in both Column 12 and in Column 13? Thanks!

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim DelimiterType As String
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
DelimiterType = ", "
If Destination.Count > 1 Then Exit Sub

On Error Resume Next
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError
If Not Destination.Column = 12 Then GoTo exitError
If Intersect(Destination, rngDropdown) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newValue = Destination.Value
Application.Undo
oldValue = Destination.Value
Destination.Value = newValue
If oldValue = "" Then
'do nothing
Else
If newValue = "" Then
'do nothing
Else
Destination.Value = oldValue & DelimiterType & newValue
' add new value with delimiter
End If
End If
End If

exitError:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

 

[shamimarita]

Hello,
I am developing an excel spreadsheet to track some data, and I found the below code to select multiple options in a drop down menu. This works great, in the column (12) that it is intended to work in.

However, I have a second column that I need to be able to make multiple selections on a drop down menu in, but this menu is using a different list than the original (12) column. Is anyone able to help me with the below code so that it will allow me to make multiple selections in both Column 12 and in Column 13? Thanks!

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim DelimiterType As String
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
DelimiterType = ", "
If Destination.Count > 1 Then Exit Sub

On Error Resume Next
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError

If rngDropdown Is Nothing Then GoTo exitError
If Not Destination.Column = 12 Then GoTo exitError
If Intersect(Destination, rngDropdown) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newValue = Destination.Value
Application.Undo
oldValue = Destination.Value
Destination.Value = newValue
If oldValue = "" Then
'do nothing
Else
If newValue = "" Then
'do nothing
Else
Destination.Value = oldValue & DelimiterType & newValue
' add new value with delimiter
End If
End If
End If

exitError:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Hello Rw33,

To create multiple selections in both Column 12 and Column 13 with different lists, you need to check the Destination column as either 12 or 13 to allow multiple selections for both columns while keeping their respective lists.

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
    Dim DelimiterType As String
    Dim rngDropdown As Range
    Dim oldValue As String
    Dim newValue As String
    DelimiterType = ", "
    If Destination.Count > 1 Then Exit Sub
    
On Error Resume Next
    Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitError

    If rngDropdown Is Nothing Then GoTo exitError
    If Not (Destination.Column = 12 Or Destination.Column = 13) Then GoTo exitError
    If Intersect(Destination, rngDropdown) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        newValue = Destination.Value
        Application.Undo
        oldValue = Destination.Value
        Destination.Value = newValue
        If oldValue = "" Then
            'do nothing
        Else
            If newValue = "" Then
                'do nothing
            Else
                Destination.Value = oldValue & DelimiterType & newValue
                ' add new value with delimiter
            End If
        End If
    End If


exitError:
    Application.EnableEvents = True
End Sub

Output:



Download the Excel File: