VBA - Combobox Hold Autofilter selection for 2nd Combobox - Dependent Comboboxes

[LNG2013]

Hello,

I have 2 comboboxes. Each Creates a unique list for 2 separate columns. When I select an item from Combobox1, it selects column A, and filters the data based on the response. I want to then select an item in Combobox2 and further filter the results.

My end result would be then to copy the results to a separate sheet.

Unfortunately, when making a selection in Combobox2 it refilters all the results based on that selection (month).


Module1 Code

Sub Auto_Open()
 
    Call TurnFilterOff
    Call ComboBox1Pop
    Call ComboBox2Pop
 
End Sub
 
Sub TurnFilterOff()
'removes AutoFilter if one exists
  Worksheets("DataRaw").AutoFilterMode = False
End Sub
Sub ComboBox1Pop()
Application.ScreenUpdating = False
 
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
 
'   The items are in A2:A60000
    Sheets("DataRaw").Select
    Set AllCells = Range("A2:A60000")
 
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell
'   Resume normal error handling
    On Error GoTo 0
'   Sort the collection (optional)
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i
'   Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
        DataReport.ComboBox1.AddItem Item
    Next Item
 
End Sub
 
Sub ComboBox2Pop()
Application.ScreenUpdating = False
 
    Dim MonthCells As Range, mCell As Range
    Dim NoDupes As New Collection
    Dim m As Integer, n As Integer
    Dim Swap3, Swap4, Item
 
'   The items are in EJ2:EJ60000
    Sheets("DataRaw").Select
    Set MonthCells = Range("EJ2:EJ60000")
 
'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each mCell In MonthCells
        NoDupes.Add mCell.Value, CStr(mCell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next mCell
'   Resume normal error handling
    On Error GoTo 0
'   Sort the collection (optional)
    For m = 1 To NoDupes.Count - 1
        For n = m + 1 To NoDupes.Count
            If NoDupes(m) > NoDupes(n) Then
                Swap3 = NoDupes(m)
                Swap4 = NoDupes(n)
                NoDupes.Add Swap3, before:=n
                NoDupes.Add Swap4, before:=m
                NoDupes.Remove m + 1
                NoDupes.Remove n + 1
            End If
        Next n
    Next m
'   Add the sorted, non-duplicated items to a ListBox
    For Each Item In NoDupes
        DataReport.ComboBox2.AddItem Item
    Next Item
 
 
        Application.ScreenUpdating = True
 
        '   Show the UserForm
    DataReport.Show
 End Sub

Userform VBA Code

Private Sub ComboBox1_Change()
 
Sheets("DataRaw").Select
Columns("A").Select
Range("A2:A60000").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
End Sub
 
Private Sub ComboBox2_Change()
 
Sheets("DataRaw").Select
Columns("EJ").Select
Range("EJ2:EJ60000").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=ComboBox2.Value
 
End Sub

Any help would be appreciated!!