Macro to select multiple values in Data Validation List

[JoaoTeixeira]

Hello everyone, I have this VBA code

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, Columns("I:I")) 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

Which allows me to select a value in a Data Validation list and keep the previous ones witch is great by the way! However, the solution only allows me to apply it to one column and not to several columns on my Sheet.

Any idea how I can get the framework working to validate the value of several columns?

[#2]

@JoaoTeixeira 

Let's say you want to apply it to columns I:K and M:P.

Change the line

    If Not Intersect(Target, Columns("I:I")) Is Nothing Then

to

    If Not Intersect(Target, Columns("I:K,M:P")) Is Nothing Then

[#3]

@JoaoTeixeira 

If you're willing to use an add-in, you can try a free Excel add-in called "Search deList". You can find it here:
Search deList 

This new version has some additional features, some of them:

• Several ways to search, like using AND or OR or LIKE operator , with or without keyword order.
• Sort the list by original order or ascending order.
• Widen or shorten the combobox width at run time.
• Insert multiple entries into the cell.

[#4]

Hi Hans, I have tried that... Is the logical solution, but unfortunately it doesn't work.

[#5]

@JoaoTeixeira 

Sorry about that. Here is a working version:

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("I:K,M:P")) Is Nothing 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 & "; " & NewValue
                    Else:
                    Target.Value = OldValue
                End If
            End If
        End If
    End If
ExitSub:
    Application.EnableEvents = True
End Sub