Activate auto-filter for columns D-J based on active checkbox in excel

Question

I have seven form control checkboxes in an excel sheet titled: chkMonday, chkTuesday, chkWednesday, chkThursday, chkFriday, chkSaturday, chkSunday.

In the same sheet there are seven columns, D-J, that represent item quantities for each day of the week.

I have auto-filters created for these columns like the example below:

Sub SundayAutofilter()

ActiveSheet.Range("$A$1:$O$1000").AutoFilter Field:=10, Criteria1:=Array("1", _
    "2", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "M", "T", "W", "F", "S"), 
Operator:=xlFilterValues

End Sub

I am looking for a way to have one macro that uses the checkbox that is selected to choose the correct column to auto-filter.

Any help with this would be greatly appreciated!

Answer 1

• Use Caller to get checkbox control's name
• Update the criteria array before apply autofilter
• All other checkboxes are unchecked when users check a checkbox
• Note: All checkboxes should be assigned the macro (right-click on checkbox > Assign Macro) named ChkEvent().

Microsoft documentation:

Application.Caller property (Excel)

Option Explicit

Sub ChkEvent()
    Dim aChkBox, aCrit, vVal As Long
    Dim sChkName As String, i As Long, iCol As Long
    Const COL_MONDAY As Long = 4
    aChkBox = Array("chkMonday", "chkTuesday", _
        "chkWednesday", "chkThursday", "chkFriday", "chkSaturday", "chkSunday")
    aCrit = Array("1", "2", "4", "5", "6", "7", "8", "9", "10", "11", _
        "12", "13", "14", "15", "")
    ' Get the chk name
    On Error Resume Next
        sChkName = Application.Caller
    On Error GoTo 0
    If Len(sChkName) = 0 Then Exit Sub
    ' Geth the chk location
    For i = 0 To UBound(aChkBox)
        If aChkBox(i) = sChkName Then
            iCol = i + COL_MONDAY
            Exit For
        End If
    Next
    If iCol = 0 Then Exit Sub
    With ActiveSheet
        ' Get the chk status
        vVal = .CheckBoxes(sChkName).Value
        ' Uncheck all chk
        .CheckBoxes(aChkBox).Value = -4146
        ' Remove filters
        If .FilterMode Then .ShowAllData
        If vVal = 1 Then ' chk is checked
            .CheckBoxes(sChkName).Value = 1
            ' Update criteria array
            aCrit(UBound(aCrit)) = .Cells(2, iCol)
            .Range("A1:O1000").AutoFilter Field:=iCol, _
                Criteria1:=aCrit, Operator:=xlFilterValues
        End If
    End With
End Sub