View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default 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!