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

theresew

New Member
Joined
Feb 24, 2019
Messages
4
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
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
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,936
Office Version
  1. 365
Platform
  1. Windows
Could you upload your workbook (without sensitive data) somewhere (maybe to dropbox.com or google drive)?
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,936
Office Version
  1. 365
Platform
  1. Windows
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?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,567
Messages
5,596,907
Members
414,110
Latest member
docops

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top