Autofilter multiple criteria using array
You could probably modify you approach using union, but better would be to
use Advanced filter. This assumes you have a database with more than one
column and you want to filter on column K. It could be modified for a
single column, but this seemed realistic.
Sub FilterArray()
Dim r As Range, r1 As Range
Dim r2 As Range, r3 As Range
Dim r4 As Range
Dim v As Variant
v = Array("A", "B", "C")
With Worksheets("Tester")
Set r = .Range(.Range("k2"), .Range("k" & .Rows.Count).End(xlUp))
Set r1 = r.CurrentRegion
Set r2 = Intersect(.Rows(1), r1.EntireColumn)
Set r3 = .Cells(1, "J").End(xlToRight)(1, 4)
r3.Resize(10, 1).ClearContents
r3.Value = .Range("K1").Value
End With
Set r4 = r3.Resize(UBound(v) - LBound(v) + 2, 1)
r4.Offset(1, 0).Resize(r4.Rows.Count - 1, 1).Value = _
Application.Transpose(v)
With Worksheets("copytoSheet")
r2.Copy .Range("a1")
Set Dest = .Range("A1").Resize(1, r2.Columns.Count)
End With
r1.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=r4, _
CopyToRange:=Dest, Unique:=False
End Sub
Just put your criteria values in the array.
--
Regards,
Tom Ogilvy
"JustMe" wrote in message
...
Is it possible to autofilter multiple criteria using an array? I'm trying
to do something like this, but I don't know how to check each element of
the array.
Really, all I'm trying to do is pull certain sets of data (determined by
the data found in column k) and copy the entire rows to a new worksheet.
I've used autofilter to do this in the past, but never to copy multiple
criteria to one sheet.
Sub filterArray()
Dim r As Range
Dim v As Variant
' pitiful first attempt
v = Array("cat", "dog", "mouse") ' I'd really like to set the array equal
to data in a named range.
With Worksheets("Tester")
Set r = .Range(.Range("k2"), .Range("k" & .Rows.count).End(xlUp))
.Columns("K:K").AutoFilter Field:=1, Criteria1:=v(0)
Set r = r.SpecialCells(xlCellTypeVisible)
.Columns("K:K").AutoFilter Field:=1, Criteria1:=v(1)
Set r = r + r.SpecialCells(xlCellTypeVisible)
.Columns("K:K").AutoFilter Field:=1, Criteria1:=v(2) '** The number of
actual elements will vary.
Set r = r + r.SpecialCells(xlCellTypeVisible)
r.EntireRow.Copy Destination:=Worksheets("CopyToSheet").Range("a1")
.AutoFilterMode = False
End With
End Sub
I hope this makes sense! Any suggestions much appreciated!
|