Autofilter multiple criteria using array

[JustMe]

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!

 

[Tom Ogilvy]

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.

 

[JustMe]

Thanks Tom.

Your code worked perfectly, but parts of it were a wee bit over my head. I
hadn't thought of using the Advanced Filter before reading your post, so I
tried this, where "rName" is a named range that contains my criteria. It
seemed like it would work, but I found that the filter missed one row - even
though it picked up another row with the same criteria. I verified that
there were no typos, the string length & cell format were the same. Isn't
that odd?


Sub Filter()

Dim r As Range

With Worksheets("Testing")

Set r = .Range(.Range("k1"), .Range("k" & .Rows.Count).End(xlUp))

Range("A:M").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=
_
Range("rName"), Unique:=False
Set r = r.SpecialCells(xlCellTypeVisible)
r.EntireRow.Copy Destination:=Worksheets("copyToSheet").Range("a1")

End With
End Sub

 

[Tom Ogilvy]

I would try to get it working manually and see if you can figure out what
the problem is. I have always found it reliable once I have the criteria
correct and the headers in the proper places. .