Multiple selection drop down list

[Raymondc190466]

Hello All,

I have found the VBA code, and it is working.

But now I want to have a second drop down list starting in G4, with other values.
2 codes with Private Sub Worksheet-Change doesn't work.
How can I solve this?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
'do nothing
        Else
            Application.EnableEvents = False
            newVal = Target.Value
            Application.Undo
            oldVal = Target.Value
            Target.Value = newVal
    If Target.Column = 6 Then
    If oldVal = "" Then
        'do nothing
    Else
        If newVal = "" Then
            'do nothing
    Else
    lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
        If Right(oldVal, Len(newVal)) = newVal Then
            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
    Else
        Target.Value = Replace(oldVal, newVal & ", ", "")
    End If
    Else
        Target.Value = oldVal _
        & ", " & newVal
    End If

        End If
    End If
    End If
End If

exitHandler:
Application.EnableEvents = True
End Sub

 

[kanadaaa]

I'm not very sure but this might work:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range, oldVal As String, newVal As String, lUsed As Long
   
    If Target.Count > 1 Then GoTo exitHandler

    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If Target.Column = 6 Or Target.Column = 7 Then 'Condition added
            If oldVal = "" Then
                'do nothing
            Else
                If newVal = "" Then
                    'do nothing
                Else
                    lUsed = InStr(1, oldVal, newVal)
                    If lUsed > 0 Then
                        If Right(oldVal, Len(newVal)) = newVal Then
                            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
                        Else
                            Target.Value = Replace(oldVal, newVal & ", ", "")
                        End If
                    Else
                        Target.Value = oldVal & ", " & newVal
                    End If
                End If
            End If
        End If
    End If

exitHandler:
Application.EnableEvents = True
End Sub

 

[mumps]

In which range is the first drop down and in which range is the second drop down?

 

[Raymondc190466]

First drop down starts in F4
Second starts in G4

But both can be in different column if this is required.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("F:G")) Is Nothing Then Exit Sub
    Dim Oldvalue As String, Newvalue As String
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
        If Oldvalue = "" Then
          Target.Value = Newvalue
        ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
          Target.Value = Oldvalue & ", " & Newvalue
        Else
          Target.Value = Oldvalue
        End If
    Application.EnableEvents = True
End Sub

Change the range (in red) to suit your needs.

 

[kanadaaa]

@Raymondc190466 Have you tried the modified version of your code in #2?

 

[Raymondc190466]

@Raymondc190466 Have you tried the modified version of your code in #2?

Hi Kanadaaa,

Code is working, just 1 small remark / question:

can it also start from a defined cell?
e.g. F4 first drop down, G4 second drop down

 

[kanadaaa]

Yes, just add

If Target.Row >= 4 Then
End if

Like below:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range, oldVal As String, newVal As String, lUsed As Long
   
    If Target.Count > 1 Then GoTo exitHandler

    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If Target.Column = 6 Or Target.Column = 7 Then
            If Target.Row >= 4 Then 'Condition added
                If oldVal = "" Then
                    'do nothing
                Else
                    If newVal = "" Then
                        'do nothing
                    Else
                        lUsed = InStr(1, oldVal, newVal)
                        If lUsed > 0 Then
                            If Right(oldVal, Len(newVal)) = newVal Then
                                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
                            Else
                                Target.Value = Replace(oldVal, newVal & ", ", "")
                            End If
                        Else
                            Target.Value = oldVal & ", " & newVal
                        End If
                    End If
                End If
            End If
        End If
    End If

exitHandler:
Application.EnableEvents = True
End Sub

But this code has too many nested IFs, so if the code in #5 works, you might want to use it instead.

 

[Raymondc190466]

Yes, just add

If Target.Row >= 4 Then
End if

Like below:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range, oldVal As String, newVal As String, lUsed As Long
  
    If Target.Count > 1 Then GoTo exitHandler

    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If Target.Column = 6 Or Target.Column = 7 Then
            If Target.Row >= 4 Then 'Condition added
                If oldVal = "" Then
                    'do nothing
                Else
                    If newVal = "" Then
                        'do nothing
                    Else
                        lUsed = InStr(1, oldVal, newVal)
                        If lUsed > 0 Then
                            If Right(oldVal, Len(newVal)) = newVal Then
                                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
                            Else
                                Target.Value = Replace(oldVal, newVal & ", ", "")
                            End If
                        Else
                            Target.Value = oldVal & ", " & newVal
                        End If
                    End If
                End If
            End If
        End If
    End If

exitHandler:
Application.EnableEvents = True
End Sub

But this code has too many nested IFs, so if the code in #5 works, you might want to use it instead.

Thank you, I will use code of #5