Filter List box by another list box multiple selections then auto filter sheet

[theresew]

I have set up a userform with tabs that filter 4 list boxes, user can make multiple selections in each list box and I would like to further filter subsequent listboxes by the previous one. Then when user makes all the selections it auto filters a spreadsheet leaving the first 2 rows above data visible.

Below is the code

Private Sub ListBox1_Click()

Call makeList2
End Sub
Private Sub ListBox2_Click()


Call makeList3
End Sub
Private Sub ListBox2_Click()


Call makeList4
End Sub


Private Sub MultiPage1_Change()
If ListBox1.ListIndex >= 0 Then
ListBox1.Selected(ListBox1.ListIndex) = False
End If
Call makeList1
Call makeList2All
Call makeList3All
Call makeList4All
End Sub


Private Sub UserForm_Initialize()
MultiPage1.Value = 0
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox2.MultiSelect = fmMultiSelectMulti
ListBox3.MultiSelect = fmMultiSelectMulti
ListBox4.MultiSelect = fmMultiSelectMulti
Call makeList1
Call makeList2All
Call makeList3All
Call makeList4All
End Sub


Sub makeList1()
Dim va, d As Object, i As Long
With Sheets("Rates")
va = .Range("A26", Range("B" & Rows.Count).End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = MultiPage1.SelectedItem.Caption Then
              If Not d.Exists(va(i, 2)) Then
              d(va(i, 2)) = 1
              dar.Add va(i, 2)
              End If
        End If
    Next
    dar.Sort
    ListBox1.List = Application.Transpose(dar.toarray())
End With
End Sub


Sub makeList2()
Dim va, d As Object, i As Long
If ListBox1.Value = vbNullString Then Exit Sub
va = Sheets("Rates").Range("B26", Sheets("Rates").Cells(Rows.Count, "C").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = ListBox1.Value Then
              If Not d.Exists(va(i, 2)) Then
              d(va(i, 2)) = 1
              dar.Add va(i, 2)
              End If
        End If
    Next
    dar.Sort
    ListBox2.List = Application.Transpose(dar.toarray())


End Sub
Sub makeList3()
Dim va, d As Object, i As Long
If ListBox2.Value = vbNullString Then Exit Sub
va = Sheets("Rates").Range("C26", Sheets("Rates").Cells(Rows.Count, "D").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
   For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = ListBox2.Value Then
              If Not d.Exists(va(i, 2)) Then
              d(va(i, 2)) = 1
              dar.Add va(i, 2)
              End If
        End If
    Next
    dar.Sort
    ListBox3.List = Application.Transpose(dar.toarray())


End Sub
Sub makeList4()
Dim va, d As Object, i As Long
If ListBox3.Value = vbNullString Then Exit Sub
va = Sheets("Rates").Range("D26", Sheets("Rates").Cells(Rows.Count, "L").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = ListBox1.Value Then
              If Not d.Exists(va(i, 9)) Then
              d(va(i, 9)) = 1
              dar.Add va(i, 9)
              End If
        End If
    Next
    dar.Sort
    ListBox4.List = Application.Transpose(dar.toarray())


End Sub
Sub makeList2All()
Dim va, d As Object, i As Long
va = Sheets("Rates").Range("A26", Sheets("Rates").Cells(Rows.Count, "C").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = MultiPage1.SelectedItem.Caption Then
              If Not d.Exists(va(i, 3)) Then
              d(va(i, 3)) = 1
              dar.Add va(i, 3)
              End If
        End If
    Next
    dar.Sort
    ListBox2.List = Application.Transpose(dar.toarray())


End Sub
Sub makeList3All()
Dim va, d As Object, i As Long
va = Sheets("Rates").Range("A26", Sheets("Rates").Cells(Rows.Count, "D").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = MultiPage1.SelectedItem.Caption Then
              If Not d.Exists(va(i, 4)) Then
              d(va(i, 4)) = 1
              dar.Add va(i, 4)
              End If
        End If
    Next
    dar.Sort
    ListBox3.List = Application.Transpose(dar.toarray())


End Sub
Sub makeList4All()
Dim va, d As Object, i As Long
va = Sheets("Rates").Range("A26", Sheets("Rates").Cells(Rows.Count, "L").End(xlUp)).Value
    Set d = CreateObject("scripting.dictionary")
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(va, 1) To UBound(va, 1)
        If va(i, 1) = MultiPage1.SelectedItem.Caption Then
              If Not d.Exists(va(i, 12)) Then
              d(va(i, 12)) = 1
              dar.Add va(i, 12)
              End If
        End If
    Next
    dar.Sort
    ListBox4.List = Application.Transpose(dar.toarray())


End Sub

 

[Akuini]

Could you upload your workbook (without sensitive data) somewhere (maybe to dropbox.com or google drive)?

 

[theresew]

ah was wondering how to do this... please find here https://www.dropbox.com/s/ymoes48ottgphf9/test.xls?dl=0

 

[Akuini]

Your workbook is an .xls file, I can open it but can’t save it (I’m using Excel 2013). It keeps showing error message when I tried to save it whether as xls or xlsm.
Can you provide an xlsm file so I won’t get problem with it?

 

[theresew]

sorry here is another link https://www.dropbox.com/s/lkz1rq8vhqp7qj0/test.xlsm?dl=0

 

[theresew]

sorry I have been searching and trying some different codes but can't seem to get it to work...
have new link
https://www.dropbox.com/s/gii4lhyejpz59xv/test.xlsm?dl=0