Excel VBA 从工作表填充父子下拉源

Question

I have sheet with data like below and 2 combo boxes in user form with the names ComboBox1(parent) and ComboBox2(child)

Parent |Child
-------|------
  A    |   1
  A    |   2
  A    |   3
  X    |   100
  X    |   101
  X    |   102

With below code I took distinct values into Parent combo.

Dim s As String, r As Integer, nr As Integer, wr, v
Set wr = Sheet1.Range("A1:A10")
nr = wr.Rows.Count
With ComboBox1
 .Clear
 For r = 1 To nr
  v = wr(r, 1)
  If InStr(s, v & ",") = 0 Then
   s = s & v & ","
   .AddItem (v)
  End If
 Next
End With

I am looking help to populate child combo based on selected value in Parent combo!

Answer 1

I recommend to use a Dictionary to remember which entries in ComboBox1 already exists because you can easily test with dict.Exists(NewItem) .

And the Data for ComboBox2 needs to automatically re-initialize on the ComboBox1_Change event.

Note that you should use more descriptive variable names s, r, nr, wr, v are pretty meaningless, while names like ComboRange1 or NewItem are pretty good readable for humans. Makes your life much easier and results in less errors.

Option Explicit

Sub InitComboBox1()
    Dim ComboRange1 As Range
    Set ComboRange1 = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, "A").End(xlUp))

    ComboBox1.Clear

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To ComboRange1.Rows.Count
        Dim NewItem As String
        NewItem = ComboRange1.Cells(i, 1).Text

        If Not dict.Exists(NewItem) Then
            dict.Add NewItem, 0
            ComboBox1.AddItem NewItem
        End If
    Next i
End Sub

Private Sub ComboBox1_Change()
    Dim ComboRange2 As Range
    Set ComboRange2 = Sheet1.Range("A1", Sheet1.Cells(Rows.Count, "A").End(xlUp)).Resize(ColumnSize:=2)

    ComboBox2.Clear

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim i As Long
    For i = 1 To ComboRange2.Rows.Count
        If ComboRange2.Cells(i, 1).Text = ComboBox1.Value Then
            Dim NewItem As String
            NewItem = ComboRange2.Cells(i, 2).Text

            If Not dict.Exists(NewItem) Then
                dict.Add NewItem, 0
                ComboBox2.AddItem NewItem
            End If
        End If
    Next i
End Sub