I have a VBA subroutine which filters records that have the text "SV-PCS7" in column 4. How can I get these results into an array?
Sub FilterTo1Criteria()
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim ro As Integer
Set xlbook = GetObject("C:\07509\04-LB-06 MX-sv.xlsx")
Set xlsheet = xlbook.Sheets("04-LB-06 MX")
With xlsheet
.AutoFilterMode = False
.Range("blockn").AutoFilter Field:=1, Criteria1:="SV-PCS7"
End With
End Sub
After applying the Range.AutoFilter Method and determining that there are visible cells, you need to work through the Range.Areas property of the Range.SpecialCells method with xlCellTypeVisible. Each of the areas will have one or more rows to process.
Sub FilterTo1Criteria()
Dim a As Long, r As Long, c As Long, vals As Variant
Dim xlSheet As Worksheet
'Set xlbook = GetObject("C:\07509\04-LB-06 MX-sv.xlsx")
Set xlSheet = Worksheets("04-LB-06 MX")
With xlSheet
If .AutoFilterMode Then .AutoFilterMode = False
'With .Range("blockn")
With .Cells(1, 1).CurrentRegion
.AutoFilter Field:=1, Criteria1:="SV-PCS7"
'step off the header row
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
'check if there are visible cells
If CBool(Application.Subtotal(103, .Cells)) Then
'dimension the array (backwards)
ReDim vals(1 To .Columns.Count, 1 To 1)
'loop through the areas
For a = 1 To .SpecialCells(xlCellTypeVisible).Areas.Count
With .SpecialCells(xlCellTypeVisible).Areas(a)
'loop through the rows in each area
For r = 1 To .Rows.Count
'put the call values in backwards because we cannot redim the 'row'
For c = LBound(vals, 1) To UBound(vals, 1)
vals(c, UBound(vals, 2)) = .Cells(r, c).Value
Next c
'make room for the next
ReDim Preserve vals(1 To UBound(vals, 1), 1 To UBound(vals, 2) + 1)
Next r
End With
Next a
End If
End With
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
'trim off the last empty 'row'
ReDim Preserve vals(1 To UBound(vals, 1), 1 To UBound(vals, 2) - 1)
'reorient the array
vals = Application.Transpose(vals)
'show the extents
Debug.Print LBound(vals, 1) & ":" & UBound(vals, 1)
Debug.Print LBound(vals, 2) & ":" & UBound(vals, 2)
'show the values
For r = LBound(vals, 1) To UBound(vals, 1)
For c = LBound(vals, 2) To UBound(vals, 2)
Debug.Print vals(r, c)
Next c
Next r
End Sub
The Preserve option can be used with the ReDim statement but only the last range can be redimensioned. I've built the array in the wrong orientation and then used the TRANSPOSE function to flip the orientation. Note: there are limits to the amount of array elements that can be successfully flipped.
If you want to avoid the complex looping of Jeeped's (excellent) solution, you can use a temp sheet to copy the visible rows first.
Sub test()
Dim src As Range, m As Variant, sh As Worksheet
Set src = Sheet1.Range("c3").CurrentRegion.SpecialCells(xlCellTypeVisible)
Set sh = Worksheets.Add
src.Copy sh.Range("a1")
m = sh.Range("a1").CurrentRegion
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Debug.Print UBound(m)
End Sub
It looks like the best way to do it is looping through each row, checking to see if the row is hidden (cell.EntireRow.Hidden = False), and adding the data for that row into the array if it's not hidden. Similar example: Easiest way to loop through a filtered list with VBA?
