• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

AutoFiltering Large Spreadsheets with multiple Criteria

Andy Forrester

New Member
I recently needed to extract some project data from a very large spreadsheet.
I needed to view some 68 projects from literally thousands
Looking at this code
Code:
Range("A1").Select
ActiveSheet.Range("A1:A5").AutoFilter Field:=1, _
  Criteria1:=Array("=*an*", "=*app*"), Operator:=xlFilterValues

I wondered how large the Array could be and wrote this code
It worked fine and I thought some would find it useful

Code:
Option Base 1
Sub Main()
Dim Prjs() As String
Dim Tgt As Worksheet
Dim Ref As Worksheet
Dim SrcW As Workbook
Dim Src As Worksheet
Dim Sel As Range
Set Ref = ThisWorkbook.Worksheets("Active Project Data")
Set Tgt = ThisWorkbook.Worksheets("Data")
rws = LastRow(Ref)
ReDim Prjs(rws - 1)
Index = 2
For i = 1 To rws - 1
  Prjs(i) = Ref.Cells(Index, 2).Value
  Index = Index + 1
Next i
ans = Application.Dialogs(xlDialogOpen).Show
Set SrcW = ActiveWorkbook
Set Src = SrcW.Worksheets("Milestones")
Src.AutoFilterMode = False
Src.Range("A5").AutoFilter Field:=5, Criteria1:=Prjs, Operator:=xlFilterValues
End Sub
 
Function LastRow(ws As Worksheet) As Integer
Dim rLastCell As Object
  On Error GoTo ErrHan
  Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByRows, _
  xlPrevious)
  LastRow = rLastCell.Row
  
ErrExit:
  Exit Function
ErrHan:
  MsgBox "Error " & Err.Number & ": " & Err.Description, _
  vbExclamation, "LastRow()"
  Resume ErrExit
End Function
 
Back
Top