Search code examples
excelvbafilteringcell

How to filter Table by entering text in cells?

I created a table and I want to filter only by 4 columns out of 33 columns.

What I did is assigned 5 cells (CountryName, ClientName, ProjNo and Date(frmDate - ToDate)). When entering text in one of those cells, the table needs to be filtered, then press a button to clear the filter of both the cells and the table.

I am facing two problems:

  1. When I press the clear button, only cells are cleared but the table is not.

  2. When I enter data in the country name, the awarded date given in the table is also filtered, and I don't know why it is being filtered as well.

Note: If there any better VBA Code to filter the table by entering in those cells, its fine also.

Screenshot of Sheet1 (Filtering Cells and Table):
Screenshot of Sheet1 (Filtering Cells and Table)

The Module (FilteringModule):

Option Explicit

Sub TableFill()
    Dim CountryName, ClientName, ProjNo As String
    Dim ToDate, FrDate As Date
    Dim MaxAmount, MinAmount As Integer
    Dim LastRow As Long
    With Sheet1
    
        LastRow = .Range("G99999").End(xlUp).Row
        If LastRow < 7 Then LastRow = 7
        If .Range("E7").Value = "Enter BV Country" Then CountryName = Empty Else: CountryName = .Range("E7").Value 'Country Name'
        If .Range("E9").Value = "Enter Client Name" Then ClientName = Empty Else: ClientName = .Range("E9").Value 'Client Name'
        If .Range("E11").Value = "Enter Proj No." Then ProjNo = Empty Else: ProjNo = .Range("E11").Value 'Proj Name'
        If .Range("E15").Value = "From Date" Then FrDate = "1/1/1900" Else: FrDate = .Range("E15").Value 'Date from'
        If .Range("E16").Value = "To Date" Then ToDate = "1/1/2030" Else: ToDate = .Range("E16").Value 'Date To'
    
    
        .Range("G6:AN" & LastRow).Select
        Selection.AutoFilter
        With .Range("G6:AN" & LastRow)
            If CountryName <> Empty Then .AutoFilter Field:=2, Criteria1:="=*" & CountryName & "*"
            If ClientName <> Empty Then .AutoFilter Field:=3, Criteria1:="=*" & ClientName & "*"
            If ProjNo <> Empty Then .AutoFilter Field:=5, Criteria1:="=*" & ProjNo & "*"
            .AutoFilter Field:=7, Criteria1:=">=" & FrDate, Operator:=xlAnd, Criteria2:="<=" & ToDate
    
        End With
    
    End With
    
End Sub
    
Sub ClearFilter()
    With Sheet1
        .Range("B4").Value = True
        .AutoFilterMode = False
        .Range("E7").Value = "Enter BV Country"
        .Range("E9").Value = "Enter Client Name"
        .Range("E11").Value = "Enter Proj No."
        .Range("E15").Value = "From Date"
        .Range("E16").Value = "To Date"
        .Range("B4").Value = False
    End With
End Sub

The Sheet1 code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E7,E9,E11,E15:E16")) Is Nothing And Range("B4").Value = False Then
        TableFill
    End If

End Sub
Solution

  • Some suggestions on your code:

    • Always name your variables to something meaningful e.g. fromDate instead of frDate
    • Use at least a basic error handling On error Goto
    • See how I divided the logic in steps (could be done even further, but you get the point)
    • In this line: Dim CountryName, ClientName, ProjNo As String only ProjNo is declared as string, the rest are variants (all of the variables should get As String)
    • You can refer to the ListObject (table) and it's range no need for lastRow
    • Finally, consider moving your filters to another range, as you apply them, they get hidden

    Replace your worksheet code with this:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Me.Range("E7,E9,E11,E15:E16")) Is Nothing Then
        ' Call the filter table procedure
        filterTable Me
    End If

End Sub

    Module code:

    Option Explicit

Public Sub clearTableFilters()

    On Error GoTo CleanFail
    
    ' Disable events so the filter table is not triggered everytime you change the filters' values
    Application.EnableEvents = False
    
    ' Set default values
    With Sheet1
        .Range("E7").Value = "Enter BV Country"
        .Range("E9").Value = "Enter Client Name"
        .Range("E11").Value = "Enter Proj No."
        .Range("E15").Value = "From Date"
        .Range("E16").Value = "To Date"
    End With
    
    ' Filter table
    filterTable Sheet1
    
CleanExit:
    ' Reenable events
    Application.EnableEvents = True
    Exit Sub
        
CleanFail:
    MsgBox "Error: " & Err.Description
    GoTo CleanExit
    
End Sub

Public Sub filterTable(ByVal sourceSheet As Worksheet)

    On Error GoTo CleanFail
        
    ' Get filter values
    With sourceSheet
        Dim countryName As String
        countryName = .Range("E7").Value
        
        Dim clientName As String
        clientName = .Range("E9").Value
        
        Dim projectNo As String
        projectNo = .Range("E11").Value
        
        Dim fromDate As Variant
        fromDate = .Range("E15").Value
        
        Dim toDate As Variant
        toDate = .Range("E16").Value

    End With
    
    ' Check if it's applying filters
    Dim applyCountryFilter As Boolean
    applyCountryFilter = getFilterStatus(countryName, "Enter BV Country", 1)
    
    Dim applyClientNameFilter As Boolean
    applyClientNameFilter = getFilterStatus(clientName, "Enter Client Name", 1)
    
    Dim projectNoFilter As Boolean
    projectNoFilter = getFilterStatus(projectNo, "Enter Proj No.", 1)
    
    Dim fromDateFilter As Boolean
    fromDateFilter = getFilterStatus(fromDate, "From Date", 2)
    
    Dim toDateFilter As Boolean
    toDateFilter = getFilterStatus(toDate, "To Date", 2)
    
    Dim applyRemoveFilters As Boolean
    applyRemoveFilters = (applyCountryFilter Or applyClientNameFilter Or projectNoFilter Or fromDateFilter Or toDateFilter)

    ' Define table to be filtered
    Dim targetTable As ListObject
    Set targetTable = Range("Table1").ListObject
    
    ' Select if applying or removing filters
    Select Case applyRemoveFilters
    Case True ' Apply
    
        ' Apply string filters
        If applyCountryFilter Then applyRemoveAutoFilter targetTable, 2, applyCountryFilter, "*" & countryName & "*"
        
        If applyClientNameFilter Then applyRemoveAutoFilter targetTable, 3, applyClientNameFilter, "*" & clientName & "*"
        
        If projectNoFilter Then applyRemoveAutoFilter targetTable, 5, projectNoFilter, "*" & projectNo & "*"

        ' Apply date filters
        Select Case True
        Case (fromDateFilter And toDateFilter)
            targetTable.Range.AutoFilter Field:=7, Criteria1:=">=" & fromDate, Operator:=xlAnd, Criteria2:="<=" & toDate
        Case (fromDateFilter = True And toDateFilter = False)
            targetTable.Range.AutoFilter Field:=7, Criteria1:=">=" & fromDate
        Case (fromDateFilter = False And toDateFilter = True)
            targetTable.Range.AutoFilter Field:=2, Criteria1:="<=" & toDate
        Case Else
            targetTable.Range.AutoFilter Field:=7
        End Select

    Case False ' Remove
        targetTable.AutoFilter.ShowAllData
        
    End Select

CleanExit:
    Exit Sub
        
CleanFail:
    MsgBox "Error: " & Err.Description
    GoTo CleanExit
    
End Sub

Private Function getFilterStatus(ByVal fieldValue As Variant, ByVal fieldDefaultValue As String, ByVal filterType As Long) As Boolean
    
    Select Case filterType
    Case 1 ' String
        getFilterStatus = Not (fieldValue = vbNullString Or LCase(fieldValue) = LCase(fieldDefaultValue))
    Case 2 ' Date
        getFilterStatus = Not (Not IsDate(fieldValue) Or ((IsDate(fieldValue) And fieldValue = 0)) Or LCase(fieldValue) = LCase(fieldDefaultValue))
    End Select

End Function

Private Function getFilterDate(ByVal sourceDate As Variant) As Date

    Select Case IsDate(sourceDate)
    Case True
        getFilterDate = sourceDate
    Case False
        getFilterDate = 0
    End Select

End Function

Private Sub applyRemoveAutoFilter(ByVal targetTable As ListObject, ByVal columnNo As Long, ByVal applyFilter As Boolean, Optional ByVal criteriaValue As Variant)

    Select Case applyFilter
    Case True
        targetTable.Range.AutoFilter Field:=columnNo, Criteria1:=criteriaValue
    Case False
        targetTable.Range.AutoFilter Field:=columnNo
    End Select

End Sub

    Adjust your clear filters button to call the clearTableFilters procedure

    Let me know if it works