Forum Discussion

JoaoTeixeira's avatar
JoaoTeixeira
MVP
Apr 07, 2024

Macro to select multiple values in Data Validation List

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?

 

excel
Macros and VBA
  • Cangkir's avatar
    Cangkir
    Brass Contributor
    Apr 09, 2024

    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.
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Apr 07, 2024

    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
    • JoaoTeixeira's avatar
      JoaoTeixeira
      MVP
      Apr 15, 2024
      Hi Hans, I have tried that... Is the logical solution, but unfortunately it doesn't work.
      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Apr 15, 2024

        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

Resources