Get a filtered range into an array

Question

I am trying to get a filtered range into an array, on my test data the array fArr has the proper dim and fLR is the proper count of the filter range

But filRange is alwa

Answer 1

My feeling is that the wildcard in your criteria is causing the trouble.

"*" only works for strings, so if your data are numbers (including dates) then they would be removed by the filter (ie they wouldn't be visible), so you would indeed only have the header in your range.

If you want numerical values, then one way of doing it would be to define a value, say:

.AutoFilter Field:=3, Criteria1:=">0"

or, if you want limits:

.AutoFilter Field:=3, Criteria1:=">0", Operator:=xlAnd, Criteria2:="<10"

If, on the other hand, you just want anything but blank cells, then the syntax should be:

.AutoFilter Field:=3, Criteria1:="<>"

You should also be aware that if the filtered range contains non-contiguous ranges, then each 'separate' range would be contained within the Areas collection. This means something like filRange.Rows.Count would only return the row count of the first area; and you can get real difficulties when you try to Offset and/or Resize the filtered range. It's also not possible to directly read non-contiguous ranges into an array using the .Value property.

I'm not sure your code is the most efficient way of handling your task, but keeping the same structure it could look like this:

Dim rRange As Range, filRange As Range
Dim myArea As Range, myRow As Range, myCell As Range
Dim fArr() As Variant
Dim r As Long

With ThisWorkbook.Worksheets("Z")
    .AutoFilterMode = False
    Set rRange = .UsedRange
End With

With rRange
    .AutoFilter Field:=3, Criteria1:=">0"
    Set filRange = .SpecialCells(xlCellTypeVisible)
End With

With filRange
    r = -1 'start at -1 to remove heading row
    For Each myArea In filRange.Areas
        r = r + myArea.Rows.Count
    Next
    ReDim fArr(1 To r, 1 To .Columns.Count)
End With

r = 1
For Each myArea In filRange.Areas
    For Each myRow In myArea.Rows
        If myRow.Row <> 1 Then
            For Each myCell In myRow.Cells
                fArr(r, myCell.Column) = myCell.Value
            Next
            r = r + 1
        End If
    Next
Next

Answer 2

Perhaps your data has more complexity, but you can simply assign the values of a range to an array with:

var = rng.SpecialCells(xlCellTypeVisible).Value

Thus no need to loop over the data.

Here's a working example with this simple grid of data:

This code:

Option Explicit

Sub arrFilterdRng()

    Dim ws As Worksheet '<-- your worksheet
    Dim rng As Range    '<-- your range to filter
    Dim var As Variant  '<-- will hold array of visible data
    Dim lng1 As Long, lng2 As Long

    ' get sheet; remove filters
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    ws.AutoFilterMode = False

    ' get range; apply filter
    Set rng = ws.UsedRange
    rng.AutoFilter Field:=1, Criteria1:="x"

    ' assign visible range to array
    var = rng.SpecialCells(xlCellTypeVisible).Value

    ' test array
    For lng1 = LBound(var, 1) To UBound(var, 1)
        For lng2 = LBound(var, 2) To UBound(var, 2)
            Debug.Print var(lng1, lng2)
        Next lng2
    Next lng1

End Sub

Results in this on the sheet:

And the output to the Immediate window for the content of var is:

a
b
c
x
 2 
 3 
x
 5 
 6