Dave F
Dave F

Reputation: 119

Save autofilter settings and reapply

I have two Excel tables, and an existing macro that copies data from one of these tables (Table A) and pastes it to bottom of the other (Table B). I have discovered that if Table A is filtered, this macro will not work because it says that it cannot copy data from a filtered table. I want to modify my existing macro such that it first copies any filters (any, all, or none of my columns may be filtered when I run the macro), then removes them, then runs my previously programmed activities, then reapplies the saved filters, then gets me a beer. I'd settle for it doing everything shy of getting me a beer, though.

I assume that this is a common problem, so I have searched for some code that I can place at the beginning and end of my existing code. I have found the following, but when i add it to my existing code and run the macro, i get an error on the early line which reads: "currentFiltRange = .Range.Address" The error states, "Object variable or With block variable not set". I've very new to VBA and do not know what is wrong with the following code that I copied.

Sub CopyThisWeekToRollupAndFilter()


    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer

    Set w = ActiveWorkbook.Sheets("Weekly")

    ' Capture AutoFilter settings
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Criteria1
                        If .Operator Then
                            filterArray(f, 2) = .Operator
                            filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
                        End If
                    End If
                End With
            Next f
        End With
    End With

    'Remove AutoFilter
    w.AutoFilterMode = False

' Add my existing code here'

' Restore Filter settings
    For col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col


End Sub

Upvotes: 0

Views: 2050

Answers (3)

Tim Williams
Tim Williams

Reputation: 166196

If AutoFilter is not turned on then w.AutoFilter will be Nothing

You should add a check to your code to first see if filtering is on or not

E.g.

isFiltered = Not w.AutoFilter Is Nothing

so you can skip capturing/reapplying the settings

EDIT: something like this:

Sub CopyThisWeekToRollupAndFilter()


    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer, isFiltered As Boolean

    Set w = ActiveWorkbook.Sheets("Weekly")
    isFiltered = Not w.AutoFilter Is Nothing 

    If isFiltered Then
    ' Capture AutoFilter settings
    With w.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Criteria1
                        If .Operator Then
                            filterArray(f, 2) = .Operator
                            filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
                        End If
                    End If
                End With
            Next f
        End With
    End With
    'Remove AutoFilter
    w.AutoFilterMode = False

    End If  'was filtered


' Add my existing code here'

    If isFiltered Then
    ' Restore Filter settings
    For col = 1 To UBound(filterArray(), 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                w.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col
    End If 'was filtered


End Sub

Upvotes: 0

W-hit
W-hit

Reputation: 361

I hope there is a better answer than this, but it may help if you haven't found anything that works. The preset filters will stay the same:

Sub Hide_Unhide()
    Dim HiddenColumn() As Long
    Dim HiddenRow() As Long
    Dim colCounter As Long, rowCounter As Long, arrColLength As Long, arrRowLength As Long
    arrColLength = 0
    arrRowLength = 0

    Application.ScreenUpdating = False

    'Unhide columns
    For colCounter = 1 To ActiveSheet.UsedRange.Columns.Count
        If Columns(colCounter).Hidden = True Then
            arrColLength = arrColLength + 1
            ReDim Preserve HiddenColumn(1 To arrColLength)
            HiddenColumn(arrColLength) = colCounter
            Columns(colCounter).Hidden = False
        End If
    Next colCounter

    'Unhide rows
    For rowCounter = 1 To ActiveSheet.UsedRange.Rows.Count
        If Rows(rowCounter).Hidden = True Then
            arrRowLength = arrRowLength + 1
            ReDim Preserve HiddenRow(1 To arrRowLength)
            HiddenRow(arrRowLength) = rowCounter
            Rows(rowCounter).Hidden = False
        End If
    Next rowCounter

    'Your code here


    'apply hiddend columns
    For colCounter = 1 To arrColLength
        Columns(HiddenColumn(colCounter)).Hidden = True
    Next colCounter

    'apply hiddend rows
    For rowCounter = 1 To arrRowLength
        Rows(HiddenRow(rowCounter)).Hidden = True
    Next rowCounter

    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Darrell H
Darrell H

Reputation: 1886

If you are talking about tables, they are not filtered ranges, they are ListObjects and you would call their range in the following manner

currentFiltRange = ActiveWorkbook.Sheets("Weekly").ListObjects("Table1").Range.Address

Here is a link that gives a VBA guide to tables: https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Here is a link to an example of what you are trying: https://www.get-digital-help.com/2012/09/26/copy-excel-table-filter-criteria-vba/

Upvotes: 1

Related Questions