Change Drop Down List Source based on user selection in another drop down

Question

I wrote some code to change the source of the drop down list.

When a user selects a value from a list in AG3 then the source of AG4 is changed.

It works in Excel 64 but I get an error stating the procedure is too large in Excel 32.

I've tried to find out how to put all the values and source ranges in an Array.

If Not Intersect(Target, Range("AG3")) Is Nothing And InStr(1, Range("AG3"), "5.75") > 0 Then
    With Range("AG4").Validation
        .Delete
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
          xlBetween, Formula1:="='DropdownLists'!P2:P6"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If

I paste about 100 of these just changing the user selection (5.75) and the range of the drop down list in AG4 (P2:P6). If I put these values in an Array I think I can fix it.

Abdallah El-Yaddak Abdallah El-Yaddak · Accepted Answer · 2019-06-02T04:02:42

Firstly, write the values in a sheet, like this:

    A  |           B            |  C   |   D    ....
   5.75| 'DropdownLists'!P2:P6  |      |
   ...
   100.

Then, give the range A1:B100 (or about 100 as you said) a name. ("ArrayInRange" in this example)

Then, you can load the values into an array as follows:

Dim Arr() as Variant
Arr = Range("ArrayInRange")

So, you can replace your event handler by this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Arr() As Variant, i As Long
    If Intersect(Target, Range("AG3")) Is Nothing Then Exit Sub 'Check once instead of 100
    Arr = Range("ArrayInRange")
    For i = LBound(Arr,1) To UBound(Arr,1)
        If InStr(1, Range("AG3"), Arr(i, 1)) > 0 Then
            With Range("AG4").Validation
                .Delete
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=" & Arr(i, 2)
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    Next
End Sub

Another solution (that might be better) is to add a third column with a formula to check if the value in column a is found within AG3 The formula in the third column will be: =IFERROR(FIND(A1,$AG$3),"")

Then, you can use this event handler:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim R As Variant
    If Not Intersect(Target, Range("AG3")) Is Nothing Then 'Check once instead of 100
        R = WorksheetFunction.Match(0, Range("ArrayInRange").Parent.Columns(3), -1)
        If Not IsError(R) Then
            With Range("AG4").Validation
                .Delete
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=" & Range("ArrayInRange").Cells(R, 2).Value
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
End Sub

Change Drop Down List Source based on user selection in another drop down

1 Answers