Get Excel filter results into VBA array

Question

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

Answer 1

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

Answer 2

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?

Answer 3

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.