excelvbaadvanced-filter

.ShowAllData after Advanced Filter, Table not fully "clearing"


I've got an issue with a search function I'm building.

The actual filter seems to work pretty well and returns what is expected. The user selects criteria from several drop down lists, those are then written to the criteria field that is used in the advanced filter.

The Problem comes when I go to clear the advanced filter (code below). The table does indeed get "cleared", however there is really odd.. Formatting? afterwards.

nearly all of the rows on the table have the same background (instead of alternating light - dark - light etc), except the rows that had been the results of the previous filter.

this is causing issues when a new filter is applied to the table, wherein all rows AFTER the last row from the previous filter will not get hidden, and if the table is "cleared" again, only the rows UP UNTIL that last row will show, requiring me to manually unhide those rows at the end of the datatable.

The weirdness does correct itself after double clicking into a cell to edit and then clicking out of it. This isn't a feasible fix however and I'm not even sure how to code something like that in...

I know that applying a filter over a filter can create weirdness but this is happening even when I run things manually line by line.

I'm honestly not sure what I'm doing wrong here or what's happening with the code so if anyone has any insight I'd be grateful!

Public Sub Apply_Filters(Optional button_name As String)

Const ProcName As String = "Apply_Filters"
On Error GoTo Whoa

Dim WsCP As Worksheet: Set WsCP = ActiveWorkbook.Sheets("Core Pack BDDS")
Dim WsDND As Worksheet: Set WsDND = ActiveWorkbook.Sheets("DO NOT DELETE")
Dim WsSizes As Worksheet: Set WsSizes = ActiveWorkbook.Sheets("Sizes DO NOT DELETE")

'Stuff to be able to find specific categories in the BDDS data table
Dim TableHeaders As Variant: TableHeaders = "Table1[#Headers]"                  'Header row for the main data table
Dim MainDataTable As String: MainDataTable = "Table1"                           'Should be the main table on the BDDS
Dim MainTable As ListObject: Set MainTable = WsCP.ListObjects(MainDataTable)    'Mimics synax to call on the main data table as a variable (to make things cleaner)
Dim WholeMainTable As Range: Set WholeMainTable = WsCP.Range(WsCP.Range(TableHeaders), WsCP.Range(TableHeaders).End(xlDown))

Dim Grp1Criteria As Range

Dim StartTime As Double
Dim ElapsedTime As Double

'Dim button_name As String: button_name = "Test"

'StartTime = MicroTimer

    WsSizes.Range("AD10:AP10").Calculate 'ensuring cells are updated before use
    WsSizes.Range("AD14:AJ14").Calculate 'ensuring cells are updated before use
    WsSizes.Range("AD16:AH16").Calculate 'ensuring cells are updated before use

    If WsSizes.Range("AD10").Value = 0 And WsSizes.Range("AD14").Value = 0 And WsSizes.Range("AD16").Value = 0 Then
        Debug.Print button_name & " - " & ProcName & " - " & " Filters NOT applied"
        GoTo SafeExit
            Else
            
            Call Clear_BDDS_Table
            
            WsDND.Range("BZ4:CS4").Calculate 'ensuring cells are updated before use
            
            Set Grp1Criteria = WsDND.Range("BZ3").CurrentRegion
            
            WholeMainTable.AdvancedFilter xlFilterInPlace, Grp1Criteria
            
            Debug.Print button_name & " - " & ProcName & " - " & " Filters applied"
    End If
    
    ElapsedTime = MicroTimer - StartTime
    
SafeExit:
    
    Debug.Print button_name & " - " & ProcName & " - " & ElapsedTime & " seconds"
    
    Exit Sub

Whoa:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    MsgBox "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume SafeExit

End Sub

The problem seems to be coming from when I'm trying to clear the filters. I use the following code

Public Sub Clear_BDDS_Table(Optional button_name As String)

Const ProcName As String = "Clear_BDDS_Table"
On Error GoTo Whoa

Dim WsCP As Worksheet: Set WsCP = Sheets("Core Pack BDDS")
Dim TableHeaders As Variant: TableHeaders = "Table1[#Headers]"                  'Header row for the main data table
Dim MainDataTable As String: MainDataTable = "Table1"                           'Should be the main table on the BDDS
Dim MainTable As ListObject: Set MainTable = WsCP.ListObjects(MainDataTable)    'Mimics synax to call on the main data table as a variable (to make things cleaner)
Dim WholeMainTable As Range: Set WholeMainTable = WsCP.Range(WsCP.Range(TableHeaders), WsCP.Range(TableHeaders).End(xlDown))

If WsCP.FilterMode = True Then
    WsCP.ShowAllData
End If

    Debug.Print button_name & " - " & ProcName & " ran successfully"

SafeExit:

    Exit Sub

Whoa:
    Debug.Print button_name & " - " & "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    MsgBox "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume SafeExit

End Sub

Solution

  • I seem to have figured out the problem.

    This post here was helpful in fixing this problem... autofilter not including all rows when filtering using vba

    Seems to have stemmed from when I was declaring the table range at the beginning of the Apply_Filters sub.

    VBA stored the last row in that range as the end of the table and after the table was cleared that stayed as the last row.

    Dim TableHeaders As Variant: TableHeaders = "Table1[#Headers]"                  'Header row for the main data table
    Dim MainDataTable As String: MainDataTable = "Table1"                           'Should be the main table on the BDDS
    Dim MainTable As ListObject: Set MainTable = WsCP.ListObjects(MainDataTable)    'Mimics synax to call on the main data table as a variable (to make things cleaner)
    Dim WholeMainTable As Range
    
    Dim Grp1Criteria As Range
    
    Dim StartTime As Double
    Dim ElapsedTime As Double
    '
    'Dim button_name As String: button_name = "Test"
    
    'StartTime = MicroTimer
    
        WsSizes.Range("AD10:AP10").Calculate 'ensuring cells are updated before use
        WsSizes.Range("AD14:AJ14").Calculate 'ensuring cells are updated before use
        WsSizes.Range("AD16:AH16").Calculate 'ensuring cells are updated before use
    
        If WsSizes.Range("AD10").Value = 0 And WsSizes.Range("AD14").Value = 0 And WsSizes.Range("AD16").Value = 0 Then
            Debug.Print button_name & " - " & ProcName & " - " & " Filters NOT applied"
            GoTo SafeExit
                Else
                
                Call Clear_BDDS_Table
                
                WsDND.Range("BZ4:CS4").Calculate 'ensuring cells are updated before use
                
                Set WholeMainTable = WsCP.Range(WsCP.Range(TableHeaders), WsCP.Range(TableHeaders).End(xlDown))
    
                Set Grp1Criteria = WsDND.Range("BZ3").CurrentRegion
                
                WholeMainTable.AdvancedFilter xlFilterInPlace, Grp1Criteria
                
                Debug.Print button_name & " - " & ProcName & " - " & " Filters applied"
        End If
    

    Moving the declaration of the range AFTER clearing the table fixed my issue.

    Live and learn, hope this might help someone else in the future.