Using CheckBox as autofilter buttons (excel VBA)

Question

I am looking to use multiple (5) checkboxes to filter a single column in an excel table. The column to be filtered contains several markers namely

 "","r","x","s","t"

Here a picture of the boxes:

My aim is to tick several boxes and include all the columns with said marker. Using straightforward methods results in the previous filter being cleared instead of being "added".

Here a picture of my (now two) tracking columns, one containing the identifier and another hidden converting that too the checkbox captions using ifs statements so @zac's solution works.

I have a looked around a lot and found a thread on MrExcel where some code was provided however I was unable to adapt it to my exact needs. Sadly whichever button I press it keeps defaulting to the blank ("") marker.

Below is my code for a sub that should be called by each checkbox.

Background info:
The identifier value are defined in a table and assigned a dynamic named range "tracking" The column to be filtered is called ("Project Flag")
The code is contained in a seperate module

Sub Project_Filter()
    Dim objcBox As Object
    Dim cBox As Variant
    Set Dbtbl = Sheets("Database").ListObjects("Entire")
    ReDim cBox(0)

    Dim trackers() As String
    Dim i As Integer
    Dim x As Variant

      i = -1
        For Each x In Range("Tracking").Cells 'reading named range into array
            i = i + 1
            ReDim Preserve trackers(i) As String
            trackers(i) = x.Value
        Next x

    Application.ScreenUpdating = False
    With Sheets("Database")
            For Each objcBox In .OLEObjects
                If TypeName(objcBox.Object) = "CheckBox" Then 'looking for checkboxes
                    If objcBox.Object.Value = True Then
                        cBox(UBound(cBox)) = trackers(i) 'setting cbox array as nth trackers value
                        i = i + 1
                        ReDim Preserve cBox(UBound(cBox) + 1)
                    End If
                End If
            Next
        If IsError(Application.Match((cBox), 0)) Then
            MsgBox "Nothing Selected"
            Exit Sub
        End If

        ReDim Preserve cBox(UBound(cBox))
        If Not .AutoFilterMode Then
            Dbtbl.Range.AutoFilter
            Dbtbl.Range.AutoFilter Field:=Dbtbl.HeaderRowRange.Find("Project Flag").Column, Criteria1:=Array(cBox)
        End If
    End With
    Application.ScreenUpdating = True
End Sub

So after some trial and error i found out that the array cbox() only contains the first value of my trackers array, hence it only filtering the blank entries. No idea what causes that but thought it might be noteworthy

They are being cleared (not over written) because you are clearing the filter before setting the new filter. You could get the current filters, add/remove them based on newly selected/unselected filter and then apply those. Tip: although Variant types are convenient and useful at times, try true declarations for your variables — Zac
The line If x.Value = "" Then Exit For may be causing the loop to end prematurely. — Gary's Student
@Gary'sStudent I have tried that and it didn't seem to make a difference. Removed it from the code cause it's not helping either way, so thanks for that. — Nick
@zac thanks for the suggestion but (and correct me if I'm wrong) wouldn't that approach result in a lot of convoluted if statements? I would have to add an if case for each box checking the value of the other 4 boxes and their status. I mean it would work but it can't be the cleanest way to do it right? Also reagarding your tip do you mean to Dim As Boolean ? Cause if not i'm a bit confused. Quite the rookie in terms of coding in general — Nick

Zac Zac · Accepted Answer · 2019-04-02T09:47:01

Based on our conversation and the picture of your checkboxes in your description, we can get the filter text from the caption:

Option Explicit

Sub Project_Filter()

    Dim oOLE As Object
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet1")   ' <--- Remeber to change this
    Dim aFilter As Variant
    Dim sFilterChar As String

    ' Referenc the sheet
    With oWS

        ' If 'All Projects' checkbox is selected, unselect all other checkboxes
        If .OLEObjects("chkAll").Object.Value Then

            ClearCheckboxes

        End If

        ' Loop to capture all selected check boxes
        For Each oOLE In .OLEObjects

            If TypeName(oOLE.Object) = "CheckBox" And oOLE.Object.Value And oOLE.Object.Caption <> "All Projects" Then

                If Not IsArray(aFilter) Then
                    ReDim aFilter(0)
                Else
                    ReDim Preserve aFilter(UBound(aFilter) + 1)
                End If

                sFilterChar = Mid(oOLE.Object.Caption, 2, 1)
                If sFilterChar = "]" Then
                    aFilter(UBound(aFilter)) = ""
                Else
                    aFilter(UBound(aFilter)) = sFilterChar
                End If

            End If

        Next

        ' Set the filter based on selection
        If IsArray(aFilter) Then
            .ListObjects("Table1").Range.AutoFilter field:=2, Criteria1:=aFilter, Operator:=xlFilterValues
        Else
            .ListObjects("Table1").Range.AutoFilter
        End If

    End With

    ' Clear Object
    Set oWS = Nothing

End Sub

' Clear all checkboxes other than 'All Projects' checkbox
Private Sub ClearCheckboxes()

    Dim oOLE As Object
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet1")   ' <--- Remeber to change this

    With oWS

        ' Clear checkboxes
        For Each oOLE In .OLEObjects

            If TypeName(oOLE.Object) = "CheckBox" And oOLE.Object.Caption <> "All Projects" Then

                If oOLE.Object.Value Then
                    oOLE.Object.Value = False
                End If

            End If

        Next

    End With

    ' Clear object
    Set oWS = Nothing

End Sub

NOTE: I have All Projects as a checkbox as well

Using CheckBox as autofilter buttons (excel VBA)

1 Answers