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
I wondered how large the Array could be and wrote this code
It worked fine and I thought some would find it useful
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