Listboxes with Checkboxes to filter dataClosed

Question

Hello, 

Greetings! 

I have a query regarding making dashboard. I have a data sheet where all data is managed. I want slicer with listbox having check boxes to filter the data based on the multi selection from listbox. I have 09 listbox. When I select Company Name or Names from listbox, 2nd list box display the checkbox list based on selection of Parent listbox and so on. By default, all checkbox must be marked or true and I need Select All / Unselect All checkbox as well and data to be filter based on selections. All listbox must be auto update based on data. 

File Link 
https://we.tl/t-ALDJiYs9uK


Regards, 
Naeem



System Configuration: Windows / Chrome 74.0.3729.131

ac3mark · Answer

There is no listbox with checkboxes in VBA.

ac3mark · Answer

I will take it one step further.....

Sub checkbox1_click ()
Select_all
End sub
 
Sub select_all ()
For n=0 to listbox1.listcount -1
Listbox.selected (n)=true
Next
End sub
 

Now all you have to do is trap whether the checkbox1 is already true, and deselect all of them all.


Have fun

TrowaD · Answer

Hi GSN,

The way I set this up is that the listboxes control the slicers, which filter the data. The visible data will then be copied to the third sheet, where each column of data will be given a name and that named range is then used to repopulate the listboxes.

These are the steps required to set this up:

1. Create a "Table" for the data on the 'Data' sheet. The "Table" option can be found on the "Insert" ribbon.

2. Create "Slicers" for all the columns you have listboxes for. Move the slicers out of sight The "Slicer" option can also be found on the "Insert" ribbon.

3. Clear "Sheet3" and paste the data below in A1 (which should populate A1:I3): 

Company	Department	Sub-Department	Location	Employee Status	Employee Category	Job Category	Qualification Levels	Religion
None	None	None	None	None	None	None	None	None
All	All	All	All	All	All	All	All	All

So the 1st row is used for the slicer names, the 2nd row for None and the 3rd for All.

4. On 'Sheet3' select A2:A3 and give it the name "Company". Type the name in the field on the top left where is says either A2 or A3.

5. Change the "ListFillRange" value of "Listbox1" into "Company". On the "Development" ribbon, click on the "Design mode" button. Right-click "Listbox1" and select "properties". Here you can find "ListFillRange". Don't forget to exit "Design mode".

6. Time to implement some code. Which I will paste at the bottom to keep the "steps" together.

7. Click on "All" on the 1st listbox to populate the other listboxes, then click on "All" on the 2nd listbox to populate the 1st listbox.

Now you are all set to play around and see if it is to your liking. What do you like and what not? The All/None options are a bit tricky.

Best regards,
Trowa


Code for sheet 'HR Dashboard':
Public pLoop As Boolean

Private Sub ListBox1_Change()
If pLoop = False Then
    pLoop = True
    Listbox_1
End If
End Sub

Private Sub ListBox2_Change()
If pLoop = False Then
    pLoop = True
    Listbox_2
End If
End Sub

Private Sub ListBox3_Change()
If pLoop = False Then
    pLoop = True
    Listbox_3
End If
End Sub

Private Sub ListBox4_Change()
If pLoop = False Then
    pLoop = True
    Listbox_4
End If
End Sub

Private Sub ListBox5_Change()
If pLoop = False Then
    pLoop = True
    Listbox_5
End If
End Sub

Private Sub ListBox6_Change()
If pLoop = False Then
    pLoop = True
    Listbox_6
End If
End Sub

Private Sub ListBox7_Change()
If pLoop = False Then
    pLoop = True
    Listbox_7
End If
End Sub

Private Sub ListBox8_Change()
If pLoop = False Then
    pLoop = True
    Listbox_8
End If
End Sub

Private Sub ListBox9_Change()
If pLoop = False Then
    pLoop = True
    Listbox_9
End If
End Sub

Code for sheet 'Sheet3':
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Integer
Application.EnableEvents = False

If Not Intersect(Target, Columns("A")) Is Nothing Then
    Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
    Range("A2:A" & lRow).Name = "Company"
ElseIf Not Intersect(Target, Columns("B")) Is Nothing Then
    Columns("B").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp).Row
    Range("B2:B" & lRow).Name = "Department"
ElseIf Not Intersect(Target, Columns("C")) Is Nothing Then
    Columns("C").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("C" & Rows.Count).End(xlUp).Row
    Range("C2:C" & lRow).Name = "Sub_Department"
ElseIf Not Intersect(Target, Columns("D")) Is Nothing Then
    Columns("D").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("D" & Rows.Count).End(xlUp).Row
    Range("D2:D" & lRow).Name = "Location"
ElseIf Not Intersect(Target, Columns("E")) Is Nothing Then
    Columns("E").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Row
    Range("E2:E" & lRow).Name = "Employee_Status"
ElseIf Not Intersect(Target, Columns("F")) Is Nothing Then
    Columns("F").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("F" & Rows.Count).End(xlUp).Row
    Range("F2:F" & lRow).Name = "Employee_Category"
ElseIf Not Intersect(Target, Columns("G")) Is Nothing Then
    Columns("G").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("G" & Rows.Count).End(xlUp).Row
    Range("G2:G" & lRow).Name = "Job_Category"
ElseIf Not Intersect(Target, Columns("H")) Is Nothing Then
    Columns("H").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("H" & Rows.Count).End(xlUp).Row
    Range("H2:H" & lRow).Name = "Qualification_levels"
ElseIf Not Intersect(Target, Columns("I")) Is Nothing Then
    Columns("I").RemoveDuplicates Columns:=1, Header:=xlYes
    lRow = Sheets("Sheet3").Range("I" & Rows.Count).End(xlUp).Row
    Range("I2:I" & lRow).Name = "Religion"
Else
    Exit Sub
End If

Cells.Interior.Pattern = xlNone

Application.EnableEvents = True
End Sub

Insert a module and paste the following in it:
Dim x, lCount As Integer
Dim laNone1, laAll1, laNone2, laAll2, laNone3, laAll3, laNone4, laAll4, laNone5, laAll5, _
laNone6, laAll6, laNone7, laAll7, laNone8, laAll8, laNone9, laAll9 As Boolean

Sub Listbox_1()
lCount = ActiveSheet.ListBox1.ListCount - 1

If ActiveSheet.ListBox1.Selected(0) = True And laNone1 = False Then
    laNone1 = True
    laAll1 = False
    ActiveSheet.ListBox1.Selected(1) = False
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox1.Selected(x) = False
        ActiveWorkbook.SlicerCaches("Slicer_Company_Name").SlicerItems(ActiveSheet.ListBox1.List(x)).Selected = False
    Next x
    
ElseIf ActiveSheet.ListBox1.Selected(1) = True And laAll1 = False Then
    laNone1 = False
    laAll1 = True
    ActiveSheet.ListBox1.Selected(0) = False
    ActiveWorkbook.SlicerCaches("Slicer_Company_Name").ClearManualFilter
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox1.Selected(x) = True
    Next x
    
Else
    laNone1 = False
    laAll1 = False
    ActiveSheet.ListBox1.Selected(0) = False
    ActiveSheet.ListBox1.Selected(1) = False
    For x = lCount To 2 Step -1
        If ActiveSheet.ListBox1.Selected(x) = True Then
            ActiveWorkbook.SlicerCaches("Slicer_Company_Name").SlicerItems(ActiveSheet.ListBox1.List(x)).Selected = True
        Else
            ActiveWorkbook.SlicerCaches("Slicer_Company_Name").SlicerItems(ActiveSheet.ListBox1.List(x)).Selected = False
        End If
    Next x
End If

Sheets("Sheet3").Range("B4:B100").ClearContents
Sheets("Data").Range("G2:G1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("B4")
Sheets("HR Dashboard").OLEObjects("ListBox2").ListFillRange = Sheets("Sheet3").Range("Department").Address(External:=True)

Sheets("Sheet3").Range("C4:C100").ClearContents
Sheets("Data").Range("H2:H1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("C4")
Sheets("HR Dashboard").OLEObjects("ListBox3").ListFillRange = Sheets("Sheet3").Range("Sub_Department").Address(External:=True)

Sheets("Sheet3").Range("D4:D100").ClearContents
Sheets("Data").Range("L2:L1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("D4")
Sheets("HR Dashboard").OLEObjects("ListBox4").ListFillRange = Sheets("Sheet3").Range("Location").Address(External:=True)

Sheets("Sheet3").Range("E4:E100").ClearContents
Sheets("Data").Range("M2:M1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("E4")
Sheets("HR Dashboard").OLEObjects("ListBox5").ListFillRange = Sheets("Sheet3").Range("Employee_Status").Address(External:=True)

Sheets("Sheet3").Range("F4:F100").ClearContents
Sheets("Data").Range("N2:N1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("F4")
Sheets("HR Dashboard").OLEObjects("ListBox6").ListFillRange = Sheets("Sheet3").Range("Employee_Category").Address(External:=True)

Sheets("Sheet3").Range("G4:G100").ClearContents
Sheets("Data").Range("O2:O1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("G4")
Sheets("HR Dashboard").OLEObjects("ListBox7").ListFillRange = Sheets("Sheet3").Range("Job_Category").Address(External:=True)

Sheets("Sheet3").Range("H4:H100").ClearContents
Sheets("Data").Range("AH2:AH1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("H4")
Sheets("HR Dashboard").OLEObjects("ListBox8").ListFillRange = Sheets("Sheet3").Range("Qualification_Levels").Address(External:=True)

Sheets("Sheet3").Range("I4:I100").ClearContents
Sheets("Data").Range("AA2:AA1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("I4")
Sheets("HR Dashboard").OLEObjects("ListBox9").ListFillRange = Sheets("Sheet3").Range("Religion").Address(External:=True)

Sheet2.pLoop = False

End Sub

Sub Listbox_2()
lCount = ActiveSheet.ListBox2.ListCount - 1

If ActiveSheet.ListBox2.Selected(0) = True And laNone2 = False Then
    laNone2 = True
    laAll2 = False
    ActiveSheet.ListBox2.Selected(1) = False
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox2.Selected(x) = False
        ActiveWorkbook.SlicerCaches("Slicer_Department").SlicerItems(ActiveSheet.ListBox2.List(x)).Selected = False
    Next x
    
ElseIf ActiveSheet.ListBox2.Selected(1) = True And laAll2 = False Then
    laNone2 = False
    laAll2 = True
    ActiveSheet.ListBox2.Selected(0) = False
    ActiveWorkbook.SlicerCaches("Slicer_Department").ClearManualFilter
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox2.Selected(x) = True
    Next x

Else
    laNone2 = False
    laAll2 = False
    ActiveSheet.ListBox2.Selected(0) = False
    ActiveSheet.ListBox2.Selected(1) = False
    For x = lCount To 2 Step -1
        If ActiveSheet.ListBox2.Selected(x) = True Then
            ActiveWorkbook.SlicerCaches("Slicer_Department").SlicerItems(ActiveSheet.ListBox2.List(x)).Selected = True
        Else
            ActiveWorkbook.SlicerCaches("Slicer_Department").SlicerItems(ActiveSheet.ListBox2.List(x)).Selected = False
        End If
    Next x
End If

Sheets("Sheet3").Range("A4:A100").ClearContents
Sheets("Data").Range("F2:F1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("A4")
Sheets("HR Dashboard").OLEObjects("ListBox1").ListFillRange = Sheets("Sheet3").Range("Company").Address(External:=True)

Sheets("Sheet3").Range("C4:C100").ClearContents
Sheets("Data").Range("H2:H1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("C4")
Sheets("HR Dashboard").OLEObjects("ListBox3").ListFillRange = Sheets("Sheet3").Range("Sub_Department").Address(External:=True)

Sheets("Sheet3").Range("D4:D100").ClearContents
Sheets("Data").Range("L2:L1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("D4")
Sheets("HR Dashboard").OLEObjects("ListBox4").ListFillRange = Sheets("Sheet3").Range("Location").Address(External:=True)

Sheets("Sheet3").Range("E4:E100").ClearContents
Sheets("Data").Range("M2:M1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("E4")
Sheets("HR Dashboard").OLEObjects("ListBox5").ListFillRange = Sheets("Sheet3").Range("Employee_Status").Address(External:=True)

Sheets("Sheet3").Range("F4:F100").ClearContents
Sheets("Data").Range("N2:N1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("F4")
Sheets("HR Dashboard").OLEObjects("ListBox6").ListFillRange = Sheets("Sheet3").Range("Employee_Category").Address(External:=True)

Sheets("Sheet3").Range("G4:G100").ClearContents
Sheets("Data").Range("O2:O1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("G4")
Sheets("HR Dashboard").OLEObjects("ListBox7").ListFillRange = Sheets("Sheet3").Range("Job_Category").Address(External:=True)

Sheets("Sheet3").Range("H4:H100").ClearContents
Sheets("Data").Range("AH2:AH1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("H4")
Sheets("HR Dashboard").OLEObjects("ListBox8").ListFillRange = Sheets("Sheet3").Range("Qualification_Levels").Address(External:=True)

Sheets("Sheet3").Range("I4:I100").ClearContents
Sheets("Data").Range("AA2:AA1000").SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("I4")
Sheets("HR Dashboard").OLEObjects("ListBox9").ListFillRange = Sheets("Sheet3").Range("Religion").Address(External:=True)

Sheet2.pLoop = False

End Sub

Sub Listbox_3()
lCount = ActiveSheet.ListBox3.ListCount - 1

If ActiveSheet.ListBox3.Selected(0) = True And laNone3 = False Then
    laNone3 = True
    laAll3 = False
    ActiveSheet.ListBox3.Selected(1) = False
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox3.Selected(x) = False
        ActiveWorkbook.SlicerCaches("Slicer_Sub_Department").SlicerItems(ActiveSheet.ListBox3.List(x)).Selected = False
    Next x
    
ElseIf ActiveSheet.ListBox3.Selected(1) = True And laAll3 = False Then
    laNone3 = False
    laAll3 = True
    ActiveSheet.ListBox3.Selected(0) = False
    ActiveWorkbook.SlicerCaches("Slicer_Sub_Department").ClearManualFilter
    For x = lCount To 2 Step -1
        ActiveSheet.ListBox3.Selected(x) = True
    Next x
    
Else
    laNone3 = False
    laAll3 = False
    ActiveSheet.ListBox3.Selected(0) = False
    ActiveSheet.ListBox3.Selected(1) = False
    For x = lCount To 2 Step -1
        If ActiveSheet.ListBox3.Selected(x) = True Then
            ActiveWorkbook.SlicerCaches("Slicer_Sub_Department").SlicerItems(ActiveSheet.ListBox3.List(x)).Selected = True
        Else
            ActiveWorkbook.SlicerCaches("Slicer_Sub_Department").SlicerItems(ActiveSheet.ListBox3.List(x)).Selected = False
        End If
    Next x
End If