populate 4 combobox based on dependant combobox

[roninn75]

good day

i have a sheet with various columns eg. DISTRICT, TOWN, NAME, RATE. In another workbook i have a form with which i am calling the values in the first workbook.
i wish to populate the first combobox with the values from DISTRICT, the second combobox(TOWN) then needs to go see which values in TOWN is listed against that district in the first workbook and populate that combobox.
the third combobox then looks at the value selected in the TOWN combobox, go see what names are listed against that in the first workbook and populate the NAMES combobox with those names. lastly, the RATE combobox looks at the value selected in the NAMES combobox, go see what rates are listed against that in the first workbook and populate the RATES combobox with those values...

any assistance is highly appreciated.

[blue.chio]

Hi,
few month ago I had a similar problem, I found this code and helped me. see if it helps you.
(for the first step, in your first workbook try the code then you'll find a way to read the valus from there...)

Dim rcat1 As Long, rcat2 As Long, rcat3 As Long, rcat4 As Long
Private Sub ComboBox1_Change()
    Dim cat1 As String, cat2 As String, cat3 As String, cat4 As String
    
    ComboBox2.Clear
    ComboBox3.Clear
    ComboBox4.Clear
     
    'rcnt = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To rcat2
        If Range("a" & i).Value = ComboBox1.Value And Range("a" & i).Value <> Range("b" & i + 1).Value Then
            ComboBox2.AddItem Range("b" & i).Value
        End If
    Next
 End Sub
Private Sub ComboBox2_Change()
 ComboBox3.Clear
    ComboBox4.Clear
  For i = 2 To rcat3
        If Range("b" & i).Value = ComboBox2.Value And Range("b" & i).Value <> Range("c" & i + 1).Value Then
            ComboBox3.AddItem Range("c" & i).Value
        End If
    Next
End Sub
Private Sub ComboBox3_Change()
    ComboBox4.Clear
    For i = 2 To rcat4
        If Range("c" & i).Value = ComboBox3.Value And Range("c" & i).Value <> Range("d" & i + 1).Value Then
            ComboBox4.AddItem Range("d" & i).Value
        End If
    Next
End Sub
Private Sub UserForm_Activate()
    rcat1 = Range("a" & Rows.Count).End(xlUp).Row
    rcat2 = Range("b" & Rows.Count).End(xlUp).Row
    rcat3 = Range("c" & Rows.Count).End(xlUp).Row
    rcat4 = Range("d" & Rows.Count).End(xlUp).Row
    For i = 2 To rcat1
        If Range("a" & i).Value <> Range("a" & i + 1).Value Then
            ComboBox1.AddItem Range("a" & i).Value
        End If
    Next
End Sub

[p_nayak268]

Hi Blue,

I am looking for similar kind of solution, so i usded your code. Unfortunately it did not work. It could only populate the 'Combobox1'.Other Comboboxed failed to populate.
Finally, based on all the 4 Combobox selection, I want those rows to be populated in the 'ListBox'. I have attached the excel file.

Someone please help me. I appreciate your time and effor.

By the way, this is my first post in the forum

Thank you,
Pratap

[roninn75]

thank you Blue, i eventually did this:

    Private Sub BxStaDistrict_AfterUpdate()
        Dim Cl As Range
        Dim ClAddress As String
        Dim coll As New Collection
        Dim itm As Variant
        'if no selection in district quit
        If Me.BxStaDistrict.ListIndex < 0 Then Exit Sub
        With Sheet17
            Set rSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
        End With
        With Me
            .BxStaName.Clear
            .BxStaOIC.Clear
            Set Cl = rSource.Find(What:=Me.BxStaDistrict.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not Cl Is Nothing Then
                ClAddress = Cl.Address
                Do
                    On Error Resume Next
                    coll.Add Item:=Cl.Offset(0, 1).Value, Key:=CStr(Cl.Offset(0, 1).Value)
                    On Error GoTo 0
                    Set Cl = rSource.FindNext(After:=Cl)
                Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
            End If
            For Each itm In coll
                .BxStaName.AddItem itm
            Next itm
        End With
    End Sub

    Private Sub BxStaName_AfterUpdate()
        Dim Cl As Range
        Dim ClAddress As String
        Dim coll As New Collection
        Dim itm As Variant
        'if no selection in name quit
        If .BxStaName.ListIndex < 0 Then Exit Sub
        With Sheet17
            Set rSource = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
        End With
        With Me
            .BxStaOIC.Clear
            Set Cl = rSource.Find(What:=Me.BxStaName.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not Cl Is Nothing Then
                ClAddress = Cl.Address
                Do
                    On Error Resume Next
                    coll.Add Item:=Cl.Offset(0, 1).Value, Key:=CStr(Cl.Offset(0, 1).Value)
                    On Error GoTo 0
                    Set Cl = rSource.FindNext(After:=Cl)
                Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
            End If
            For Each itm In coll
                .BxStaOIC.AddItem itm
            Next itm
        End With
    End Sub

[blue.chio]

Hi p_nayak
Welcome to the forum!
Accordind to the forum rule 2:
"2. Don't post a question in the thread of another member -- start your own. If you feel it's particularly relevant, provide a link to the other thread. You may include up to 3 links to other URLs in a single post, no more, so only link to the relevant pages."

[p_nayak268]

Hi Blue,

Thanks, I will start a new thread.

p_nayak

[blue.chio]

Glad you did it yourself! Thank you for the feedback!