Code required to populate 3rd Combobox

[Bimmy]

Hello,

Hope someone can help me with a code for a 3rd combobox.

I was able to find a code to populate 1st 2 combobox, but, unable to find a code to populate the 3rd combobox.

Depending on what is selected in 2nd combobox I want macro to populate the 03rd combobox.

Column A----Column B---------Column C
---AA------Main Sheet------D:\AA\Main.xlsb
---AA------Source Sheet---C:\AA\Source.xlsx
---BB------Instruction------D:\BB\Instruction.txt

If AA is selected in 1st combobox and Main Sheet is selected in 2nd combobox, I want the 3rd combobox to get populated with D:\AA\Main.xlsb from Column C. Same goes for the remaining items.

Below is the code used to populate 1st 2 combobox -

Option Explicit

Private Sub cbPrimary_Change()

    Dim Name As String, R(), Counter As Integer, I As Integer
    Name = cbPrimary.Value
   
    For Counter = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(Counter, 1).Value = Name Then
            I = I + 1
            ReDim Preserve R(I - 1)
            R(I - 1) = Cells(Counter, 2).Value
        End If
    Next Counter
   
    UFSelection.cmSecondary.List = R
   
End Sub

Private Sub UserForm_Initialize()

    Dim Counter As Integer, R
   
    With CreateObject("Scripting.Dictionary")
        For Counter = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            .Item(Cells(Counter, 1).Value) = ""
        Next Counter
        R = .keys
    End With
   
    cbPrimary.List = R
   
End Sub

Kindly provide the entire working code.

Have attached sample sheet.

 

[Bimmy]

Any help will be appreciated

 

[Chihiro]

You just need this portion added.

Private Sub cmSecondary_Change()
    Dim Name As String, R(), Counter As Integer, I As Integer
    Name = cmSecondary.Value
   
    For Counter = 1 To Cells(Rows.Count, 2).End(xlUp).Row
        If Cells(Counter, 2).Value = Name Then
            I = I + 1
            ReDim Preserve R(I - 1)
            R(I - 1) = Cells(Counter, 3).Value
        End If
    Next Counter
   
    UFSelection.ComboBox1.List = R
   
End Sub

 

[Debaser]

Can column B data repeat for different values in column A? If so, you need to check both columns before adding to the array.

 

[Chihiro]

Debaser is correct.

Just modify IF statement to check for both and Dim something like Name1 as string and make it = cbPrimary.Value.

 

[Marc L]

Hi !

With no duplicate in column C, no need a third ComboBox but just a Label !

Another way with duplicates in columns A & B but not in C :​

Option Explicit

Dim AR$(), BR(), CR(), VP

Private Sub cbPrimary_Change()
           ComboBox1.Clear
           VP = Application.Match(cbPrimary.Value, AR, 0)
If IsError(VP) Then
    cmSecondary.Clear
Else
    cmSecondary.List = BR(VP)
    cmSecondary.Value = IIf(UBound(BR(VP)) = 1, BR(VP)(1), "")
End If
End Sub

Private Sub cmSecondary_Change()
    Dim V
If IsNumeric(VP) Then
        V = Application.Match(cmSecondary.Value, BR(VP), 0)
    If IsError(V) Then
        ComboBox1.Clear
    Else
        ComboBox1.List = CR(VP)(V)
        ComboBox1.Value = CR(VP)(V)(1)
    End If
End If
End Sub

Private Sub UserForm_Initialize()
    Dim C&, L&, R&, V, VA
    VA = Sheet1.UsedRange.Value
    ReDim AR(1 To UBound(VA)), BR(1 To UBound(VA)), CR(1 To UBound(VA))
For R = 1 To UBound(VA)
    V = Application.Match(VA(R, 1), AR, 0)
    If IsError(V) Then L = L + 1: AR(L) = VA(R, 1): V = L
    BR(V) = BR(V) & IIf(BR(V) > "", ",", "") & """" & VA(R, 2) & """"
    CR(V) = CR(V) & IIf(CR(V) > "", ",", "") & """" & VA(R, 3) & """"
Next
For R = 1 To L
    BR(R) = Evaluate("{" & BR(R) & "}")
    CR(R) = Evaluate("{" & CR(R) & "}")
    For C = 1 To UBound(CR(R))
        CR(R)(C) = Evaluate("{""" & CR(R)(C) & """}")
    Next
Next
    ReDim Preserve AR(1 To L)
    cbPrimary.List = AR
    If L = 1 Then cbPrimary.Value = AR(1)
End Sub

Do you like it ? So thanks to click on bottom right Like !

Edit for optimization …
​

 

[Bimmy]

Hello,

Chihiro and Marc L both your codes are doing what I asked for.

Debraser - For the time being there will be no duplicates in Column B.

Thank you ALL

 

[Marc L]

Amending to show a label could replace the third combobox :​

Option Explicit

Dim AR$(), BR(), CR(), VP

Private Sub cbPrimary_Change()
    With ComboBox1:  .Clear:  .Enabled = False:  End With
    VP = Application.Match(cbPrimary.Value, AR, 0)
With cmSecondary
    If IsError(VP) Then
        .Clear
        .Enabled = False
    Else
        .Enabled = UBound(BR(VP)) > 1
           .List = BR(VP)
          .Value = IIf(UBound(BR(VP)) = 1, BR(VP)(1), "")
    End If
End With
End Sub

Private Sub cmSecondary_Change()
        Dim V
If IsNumeric(VP) Then
    With ComboBox1
            V = Application.Match(cmSecondary.Value, BR(VP), 0)
        If IsError(V) Then
            .Clear
            .Enabled = False
        Else
            .Enabled = UBound(CR(VP)(V)) > 1
               .List = CR(VP)(V)
              .Value = CR(VP)(V)(1)
        End If
    End With
End If
End Sub

Private Sub UserForm_Initialize()
    Dim C&, L&, R&, V, VA
    VA = Sheet1.UsedRange.Value
    ReDim AR(1 To UBound(VA)), BR(1 To UBound(VA)), CR(1 To UBound(VA))
For R = 1 To UBound(VA)
    V = Application.Match(VA(R, 1), AR, 0)
    If IsError(V) Then L = L + 1: AR(L) = VA(R, 1): V = L
    BR(V) = BR(V) & IIf(BR(V) > "", ",", "") & """" & VA(R, 2) & """"
    CR(V) = CR(V) & IIf(CR(V) > "", ",", "") & """" & VA(R, 3) & """"
Next
For R = 1 To L
    BR(R) = Evaluate("{" & BR(R) & "}")
    CR(R) = Evaluate("{" & CR(R) & "}")
    For C = 1 To UBound(CR(R))
        CR(R)(C) = Evaluate("{""" & CR(R)(C) & """}")
    Next
Next
    ReDim Preserve AR(1 To L)
    cbPrimary.List = AR
    ComboBox1.Enabled = False
    If L = 1 Then cbPrimary.Value = AR(1) Else cmSecondary.Enabled = False
End Sub