Dynamic Cell-Based Filter

' Dynamic Cell-Based Filter
' Place this code in the Worksheet module where your data table exists
' Assumes data table starts at row 6, filter cells are C2 and H2

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Trigger filter when C2 or H2 changes
    On Error GoTo ErrorHandler

    Dim filterCell1 As Range
    Dim filterCell2 As Range
    Set filterCell1 = Me.Range("C2")
    Set filterCell2 = Me.Range("H2")

    ' Check if changed cell is one of the filter cells
    If Not Intersect(Target, filterCell1) Is Nothing Or _
       Not Intersect(Target, filterCell2) Is Nothing Then

        Application.EnableEvents = False
        Call ApplyDynamicFilter
        Application.EnableEvents = True
    End If

    Exit Sub

ErrorHandler:
    Application.EnableEvents = True
    MsgBox "Error applying filter: " & Err.Description, vbCritical
End Sub

Sub ApplyDynamicFilter()
    ' Apply filters based on cell values
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = Me

    Dim filterValue1 As String
    Dim filterValue2 As String

    filterValue1 = Trim(ws.Range("C2").Value)
    filterValue2 = Trim(ws.Range("H2").Value)

    ' Get the data table (assumes it starts at row 6)
    Dim dataTable As ListObject
    On Error Resume Next
    Set dataTable = ws.ListObjects(1)
    On Error GoTo ErrorHandler

    ' If table doesn't exist, create it
    If dataTable Is Nothing Then
        Dim lastRow As Long
        Dim lastCol As Long
        lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        lastCol = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column

        Set dataTable = ws.ListObjects.Add(xlSrcRange, ws.Range(ws.Cells(6, 2), ws.Cells(lastRow, lastCol)), , xlYes)
        dataTable.Name = "DataTable"
    End If

    ' Clear existing filters
    If dataTable.AutoFilter.FilterMode Then
        dataTable.AutoFilter.ShowAllData
    End If

    ' Determine which filters to apply
    Dim applyFilter1 As Boolean
    Dim applyFilter2 As Boolean

    applyFilter1 = (filterValue1 <> "")
    applyFilter2 = (filterValue2 <> "")

    ' Apply filters based on which cells have values
    If applyFilter1 And applyFilter2 Then
        ' Both filters active
        ' Find column indices (B = 1, H = 7 in table context)
        Dim col1Index As Long
        Dim col2Index As Long
        col1Index = 1 ' Column B in table (first column)

        ' Find H column index in table
        Dim i As Long
        For i = 1 To dataTable.ListColumns.Count
            If dataTable.HeaderRowRange.Cells(1, i).Column = ws.Range("H6").Column Then
                col2Index = i
                Exit For
            End If
        Next i

        ' Apply both filters with wildcard matching
        dataTable.Range.AutoFilter Field:=col1Index, Criteria1:="=*" & filterValue1 & "*"
        If col2Index > 0 Then
            dataTable.Range.AutoFilter Field:=col2Index, Criteria1:="=*" & filterValue2 & "*"
        End If

    ElseIf applyFilter1 Then
        ' Only filter 1 active (column B)
        dataTable.Range.AutoFilter Field:=1, Criteria1:="=*" & filterValue1 & "*"

    ElseIf applyFilter2 Then
        ' Only filter 2 active (column H)
        ' Find H column index
        For i = 1 To dataTable.ListColumns.Count
            If dataTable.HeaderRowRange.Cells(1, i).Column = ws.Range("H6").Column Then
                col2Index = i
                Exit For
            End If
        Next i

        If col2Index > 0 Then
            dataTable.Range.AutoFilter Field:=col2Index, Criteria1:="=*" & filterValue2 & "*"
        End If
    End If

    ' If both filter cells are empty, show all data
    If Not applyFilter1 And Not applyFilter2 Then
        If dataTable.AutoFilter.FilterMode Then
            dataTable.AutoFilter.ShowAllData
        End If
    End If

    Exit Sub

ErrorHandler:
    MsgBox "Error applying dynamic filter: " & Err.Description, vbCritical
End Sub

Sub ClearFilters()
    ' Macro to clear all filters and filter cells
    On Error Resume Next

    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' Clear filter input cells
    ws.Range("C2").ClearContents
    ws.Range("H2").ClearContents

    ' Remove filters from table
    Dim dataTable As ListObject
    Set dataTable = ws.ListObjects(1)

    If Not dataTable Is Nothing Then
        If dataTable.AutoFilter.FilterMode Then
            dataTable.AutoFilter.ShowAllData
        End If
    End If

    MsgBox "Filters cleared!", vbInformation
End Sub

Sub ShowFilteredCount()
    ' Display count of visible (filtered) rows
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim dataTable As ListObject
    Set dataTable = ws.ListObjects(1)

    If dataTable Is Nothing Then
        MsgBox "No data table found.", vbExclamation
        Exit Sub
    End If

    Dim totalRows As Long
    Dim visibleRows As Long

    totalRows = dataTable.ListRows.Count
    visibleRows = dataTable.Range.SpecialCells(xlCellTypeVisible).Rows.Count - 1 ' Subtract header

    MsgBox "Showing " & visibleRows & " of " & totalRows & " rows", vbInformation, "Filter Results"

    Exit Sub

ErrorHandler:
    MsgBox "Error counting filtered rows: " & Err.Description, vbCritical
End Sub