VBA, Storing filtered values in array

Question

My code filters out blanks and 0 records but my array is getting all values. How can I just take into account the records filtered? Is this the best way I can do this?

Sub FilterAndCopy()
Dim LastRow As Long
Dim Arr As Variant

With Worksheets("BusinessDetails")
    .Range("$A5:$AJ5").AutoFilter field:=33, Criteria1:="<>", Criteria2:="<>0", Criteria2:="<>-0"
    LastRow = .Range("AG" & .Rows.Count).End(xlUp).Row

    Arr = Range("AG8:AG" & LastRow)
    Dim R As Long
    Dim C As Long
    For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
        For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
            Debug.Print Arr(R, C)
        Next C
    Next R

    Dim Destination As Range
    Set Destination = Sheets(2).Range("D10")
    Set Destination = Destination.Resize(UBound(Arr), 1)
    Destination.Value = Application.Transpose(Arr)

     Sheets(1).ShowAllData

End With
End Sub

Updated code:

Sub FilterAndCopy()
Dim LastRow As Long
Dim Arr As Variant

With Worksheets("BusinessDetails")
    .Range("$A5:$AJ5").AutoFilter field:=33, Criteria1:="<>", Criteria2:="<>0", Criteria2:="<>-0"
    LastRow = .Range("AG" & .Rows.Count).End(xlUp).Row

    Set rFiltered = Range("A5:AJ" & LastRow).SpecialCells(xlCellTypeVisible)

    ReDim Arr(1 To rFiltered.Areas.Count)
    I = 0
    For Each V In rFiltered.Areas
        I = I + 1
        Arr(I) = V
    Next V


     rFiltered.Copy Sheets("Step 4").Range("D10")


End With
End Sub

`.SpecialCells(xlCellTypeVisible)` will let you get one contiguous area at a time, of the visible cells. — Ron Rosenfeld, Jun 09 '20 at 01:01
You may want to refer to [this question](https://stackoverflow.com/questions/62099204/is-cells-find-with-specialcellsxlcelltypevisible-possible) if you want 2D array of the filtered visible cells. [Here](https://stackoverflow.com/a/62100421/9808063) is a similar approach as Ron's for area of the filtered range. — Naresh, Jun 09 '20 at 14:08

Ron Rosenfeld · Accepted Answer · 2020-06-09T13:58:50.803

4

When you filter a range, you are left with different Areas.

So your choices are to read one cell at a time into the array, or one area at a time, as an array, into the Parent array.

For example, (data is in A1:C9 and the filtering is done on column A)

With Worksheets("Sheet1")
    .Range("$A1:$C9").AutoFilter field:=1, Criteria1:="<>", Criteria2:="<>0"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row


Set rFiltered = Range("A1:C" & LastRow).SpecialCells(xlCellTypeVisible)
ReDim Arr(1 To rFiltered.Areas.Count)

I = 0
For Each V In rFiltered.Areas
    I = I + 1
    Arr(I) = V
Next V

Arr will now be an array of arrays, containing only the filtered cells.

Note

If all you want to do is copy the filtered range, then:

rFiltered.Copy Sheets("sheet2").Range("D10")

Note2

If you are always going to copy, you could then put that data into the array with something like (not tested):

arr = Sheets("sheet2").Range("D10").CurrentRegion

edited Jun 09 '20 at 13:58

answered Jun 09 '20 at 01:07

Ron Rosenfeld

53,870
7
28
60

Thanks Ron, I am having trouble pasting this copied range to sheet 2. When using `rFiltered.Copy Sheets("sheet2").Range("D10")` it is copying the full data set from Sheet 1. Is there a way just to bring the filtered column over? – excelguy Jun 12 '20 at 16:17
@excelguy How did you `Set rFiltered`? The technique I showed in my answer works here. – Ron Rosenfeld Jun 12 '20 at 16:35
Sorry, I had the cells mixed up. Thank you. Also one more question, If you want to do 2 columns, like A and AG, how would you do these 2 only? – excelguy Jun 12 '20 at 17:23
1

@excelguy I suppose you could either do them one at a time; or hide `B:AH` and `AF:AJ` before executing `Set rFiltered = …` – Ron Rosenfeld Jun 12 '20 at 17:48

EvR · Answer 2 · 2020-06-10T08:10:25.650

2

A possibility without the use of AutoFilter and looping: (when you want to do more then only copying your filtered range)

Sub FilterAndCopyWithoutAutoFilter()
Dim rng As Range, adr As String, Fir As Long, y As Variant
  With Worksheets("BusinessDetails")
    Set rng = .Range("AG8:AG" & .Range("AG" & .Rows.Count).End(xlUp).Row)
    adr = .Name & "!" & rng.Address
    Fir = 7 'one less of first row number of your range
      With Application
       y = .Index(rng, .Transpose(Filter(.Transpose(.Evaluate("if(isnontext(" & adr & "),if(--" & adr & "<>0, row(" & adr & ")-" & Fir & ",  ""##"" ),""##"")")), "##", False)), 1)
       'or shorter when you want to include text values as well
       'y = .Index(rng, .Transpose(Filter(.Transpose(.Evaluate("if(" _
       & adr & "<>0, row(" & adr & ")-" & Fir & ",  ""##"" )")), "##", False)), 1)
       End With
   End With
    Sheets(2).Range("D10").Resize(UBound(y)).Value = y
End Sub

edited Jun 10 '20 at 08:10

answered Jun 09 '20 at 10:08

EvR

3,418
2
13
23

Think OP doesn't exclude *non text* values *per se*. How would you change the above code to include string values, too? I'd suggest to explain some `Evaluate` parts as the long code line isn't readable intuitively. - FYI You might be interested in my post regarding [Some pecularities of the `Application.Index()` funtion](https://stackoverflow.com/questions/51688593/excel-vba-insert-new-first-column-in-datafield-array-without-loops-or-api-call/51714153#51714153) – T.M. Jun 09 '20 at 21:00
1

I've included the text values as well in a seperate remarked line in above code, (the parts in the .Evaluate is just a 'normal' worksheetformula). Thanks for your linked post, the zero in array(0,1,2,3) is new for me. – EvR Jun 10 '20 at 08:16
ad) **`Application.Index()`**: the first `0` item equals another `1` item here. - FYI a further link regarding the rather unknown **double-zero-argument** in the index function, c.f. my 2nd solution at [copy multiple non-adjacent columns to array](https://stackoverflow.com/questions/62303637/copy-multiple-non-adjacent-columns-to-array/62318499#62318499) – T.M. Jun 11 '20 at 19:21

VBA, Storing filtered values in array

2 Answers2