Looping through activeX ComboBoxes on a worksheet and assigning named range to listfill

Question

I have columns A and B. Each cell in column B contains an activeX ComboBox. What I want is for the ComboBox in column B to populate in reference to a named range from a different sheet based on the input in column A (directly next to the combo box)

To do this I need to run a loop through each ComboBox on the worksheet with nested IF statements, but cannot figure out how to loop through the combo box objects and then assign a named range to the combo box if other conditions are true.

For simplicity, cell A1 would be next to ComboBox1. Cell A2 would be next to ComboBox2 etc.

Basic example:

myRange1 = ActiveWorkbook.Worksheets("Ranges").Range("NamedRange1")
myRange2 = ActiveWorkbook.Worksheets("Ranges").Range("NamedRange2")
i = 1

For Each ComboBox on ActiveWorksheet

If Cell("A" & i) 'condition1 here' Then
ComboBoxi.ListFillRange = myRange1
i = i+1
Elseif Cell("A" & i) 'condition2 here' Then
ComboBox'i'.ListFillRange = myRange2
i = i+1
Else 'do nothing

Next

Ryan Ryan · Accepted Answer · 2019-04-11T18:11:13

I think I found a cleaner way to do this. I did not realize that you do not have to specify the worksheet for the named range even though the ranges are on a separate sheet.In this example, "Range1" and "Range2" are on their own worksheet. Also, it works without declaring the ComboBoxes as Objects. ComboBoxes are left to the default names of ComboBox1, ComboBox2, and ComboBox3. Came to this solution via Populating combobox from named ranges

I'm sure there would be a good way to loop this instead of making a unique if statement for each unique cell in Range A1:A3 and associated ComboBox.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim result As String
Dim search1P As String
Dim search2P As String

search1P = "1P"
search2P = "2P"

If Not Intersect(Target, Range("A1:A3")) Is Nothing Then 'if target is within range A1:A3

result = Target.Value ' set result variable equal to whatever the target cell value is

If Not Intersect(Target, Range("A1")) Is Nothing Then 'if cell A1, evaluate cb1

    If InStr(UCase(result), search1P) <> 0 Then 'if result variable contains "1P" then
    ComboBox1.ListFillRange = "Range1" 'Populate cb1 with "Range1"
    ElseIf InStr(UCase(result), search2P) <> 0 Then 'if result variable contains "2P" then
    ComboBox1.ListFillRange = "Range2" 'populate combobox with "Range2"
    Else: ComboBox1.ListFillRange = "" 'leave cb blank if source cell is invalid
    End If

ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then 'if cell A2, update cb2

    If InStr(UCase(result), search1P) <> 0 Then 'if result variable contains "1P" then
    ComboBox2.ListFillRange = "Range1" 'Populate cb1 with "Range1"
    ElseIf InStr(UCase(result), search2P) <> 0 Then 'if result variable contains "2P" then
    ComboBox2.ListFillRange = "Range2" 'populate combobox with "Range2"
    Else: ComboBox2.ListFillRange = "" 'leave cb blank if source cell is invalid
    End If

ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then 'if cell A2, update cb3

    If InStr(UCase(result), search1P) <> 0 Then 'if result variable contains "1P" then
    ComboBox3.ListFillRange = "Range1" 'Populate cb1 with "Range1"
    ElseIf InStr(UCase(result), search2P) <> 0 Then 'if result variable contains "2P" then
    ComboBox3.ListFillRange = "Range2" 'populate combobox with "Range2"
    Else: ComboBox3.ListFillRange = "" 'leave cb blank if source cell is invalid
    End If

End If

End If

End Sub

Looping through activeX ComboBoxes on a worksheet and assigning named range to listfill

1 Answers