Dependent and non dependent comboboxes

Option Explicit
Option Base 1


Private Sub Worksheet_Activate()
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet


Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet


Set rng = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare


    For Each r In rng
        Dic(r.Value) = Empty
    Next
    
    With ComboBox1
        .ListFillRange = ""
            If .ListCount = 0 Then 'Take out to refresh
                .List = Application.Transpose(Dic.keys)
                .ListIndex = 0
            End If ' out to refresh
    End With
End Sub


Private Sub ComboBox1_Change() 'Funding Combo Box capital program yr
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim cb As ComboBox
Dim ar As Variant


Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet


ar = Array("All Sub Categories", "All Products")
Application.EnableEvents = False


Set rng = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Set sh = Sheet2 'Control Sheet


    For Each r In rng
        If r = ComboBox1 Then
            Dic(r.Offset(, 1).Value) = Empty
        End If
    Next
    
    With ComboBox2 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Categories", 0
        .ListIndex = 0
    End With
    'Add to cb 3 & 4
    For i = 3 To 4
      Dic.RemoveAll
        For Each r In rng
            If r = ComboBox1 Then
                Dic(r.Offset(, i - 1).Value) = Empty
            End If
        Next


        Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
        With cb 'Add data to the comboboxes
            .List = Application.Transpose(Dic.keys)
            .AddItem ar(i - 2), 0
            .ListIndex = 0
        End With
    Next i


    For i = 1 To 4 'Loop through the comboboxes
        Set cb = Sheet1.Shapes("ComboBox" & i).OLEFormat.Object.Object
        sh.Cells(2, i + 1) = cb.Value
    Next i


Application.EnableEvents = True
End Sub


Private Sub ComboBox2_Change() 'Geography Program
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim i As Integer
Dim cb As ComboBox
Dim sh As Worksheet
Dim ws As Worksheet


Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet


Application.EnableEvents = False
Set rng = ws.Range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
    
    If ComboBox2 = "All Categories" Then
        For Each r In rng
            Dic(r.Offset(, 1).Value) = Empty
        Next
        
        Else
        'Only items that relate to Combo 2
        For Each r In rng
            If r = ComboBox2 Then
                Dic(r.Offset(, 1).Value) = Empty
            End If
        Next
    End If


    With ComboBox3 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Sub Categories", 0
        .ListIndex = 0
    End With
   
    Dic.RemoveAll
    'NEW
        'Only items that relate to Combo 2
        For Each r In rng
            If r = ComboBox2 Then
                Dic(r.Offset(, 2).Value) = Empty
            End If
        Next
    


    With ComboBox4 'Add data to the comboboxes
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Products", 0
        .ListIndex = 0
    End With
    
    sh.[c2] = ComboBox2.Value
    Application.EnableEvents = True
End Sub


Private Sub ComboBox3_Change()
Dim rng As Range 'set the worksheet range for the procedure.
Dim r As Range 'range for the loop
Dim Dic As Object 'name for the dictionary
Dim sh As Worksheet
Dim ws As Worksheet


Set sh = Sheet2 'Control Sheet
Set ws = Sheet3 'List Sheet


Application.EnableEvents = False
Set rng = ws.Range("C2", ws.Range("C" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare


    If ComboBox3 = "All Sub Categories" Then
        For Each r In rng
            Dic(r.Offset(, 1).Value) = Empty
        Next
        
        Else
        'Only items that relate to Combo 3
        For Each r In rng
            If r = ComboBox3 Then
                Dic(r.Offset(, 1).Value) = Empty
            End If
        Next
    End If
 
    With ComboBox4
        .List = Application.Transpose(Dic.keys)
        .AddItem "All Products", 0
        .ListIndex = 0
    End With
    sh.[D2] = ComboBox3.Value
Application.EnableEvents = True
End Sub


Private Sub ComboBox4_Change()
Dim sh As Worksheet
Set sh = Sheet2 'Control Sheet


    Application.EnableEvents = False
    sh.[E2] = ComboBox4.Value
    Application.EnableEvents = True
End Sub