Reputation: 103
I want to do two successive filtering; the first on dates which I use auto-filter and on the produced result I want to do advance-filter (because I have OR in mind). So what I did first was to set a range variable to the unfiltered range.
Set rng = Range(ws.Cells(1, 1), ws.Cells(rowNos, colNos))
Then using auto-filter I filter for given dates.
rng.AutoFilter Field:=1, Criteria1:=">" & lDate
Since now some rows will be hidden, and I want to apply advanced filter, I made use of specialcells
rng.SpecialCells(xlCellTypeVisible).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=crt, CopyToRange:=thisWB.Worksheets("Sheet3").Range("A1"), _
Unique:=False
However I got an error in the last step "the command requires at least two rowa of data . . " I made sure that there were at least 100 rows which fit the criteria meaning that the error is not because of a lack of rows.
Please help me get the problem. Also if there's another way I can accomplish the task I'll be happy to change my codes. What I'm trying to do is for specific dates filter a table and then filter again for values on two columns (as is normally done with advanced filters).
Upvotes: 3
Views: 3638
Reputation: 2713
It seems like .AdvancedFilter
does not work on non-continuous ranges. The code below is a bit kludge-y, but worked for a little example I pulled together where I want to return observations that are > April 1st, 2014 where Foo = Yes and Bar = 7. My data sheet contains exactly one row that matches all those criteria.
Option Explicit
Sub FilterTwice()
Dim DataSheet As Worksheet, TargetSheet As Worksheet, _
ControlSheet As Worksheet, TempSheet As Worksheet
Dim DataRng As Range, ControlRng As Range, _
TempRng As Range
Dim lDate As Date
Dim LastRow As Long, LastCol As Long
'assign sheets for easy reference
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
Set ControlSheet = ThisWorkbook.Worksheets("Sheet2")
Set TargetSheet = ThisWorkbook.Worksheets("Sheet3")
'clear any previously-set filters
Call ClearAllFilters(DataSheet)
'assign data range
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set DataRng = Range(DataSheet.Cells(1, 1), DataSheet.Cells(LastRow, LastCol))
'assign a control (or critieria) range for the advanced filter
Set ControlRng = Range(ControlSheet.Cells(1, 1), ControlSheet.Cells(2, 2))
'apply date filter
lDate = "4/1/2014"
With DataRng
.AutoFilter Field:=1, Criteria1:=">" & lDate
End With
'add a temporary sheet and copy the visible cells to create a continuous range
Set TempSheet = Worksheets.Add
DataRng.SpecialCells(xlCellTypeVisible).Copy
TempSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
'assign temp range
LastRow = TempSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = TempSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set TempRng = Range(TempSheet.Cells(1, 1), TempSheet.Cells(LastRow, LastCol))
'apply advanced filter to temp range and get obs where foo = yes and bar = 7
With TempRng
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ControlRng, _
CopyToRange:=TargetSheet.Range("A1"), Unique:=False
End With
'remove the temp sheet and clear filters on the data sheet
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = True
DataSheet.AutoFilterMode = False
End Sub
Sub ClearAllFilters(cafSheet As Worksheet)
With cafSheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
End Sub
Upvotes: 1