Reputation: 119
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
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
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
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