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
– Ron Rosenfeld, Commented Jun 9, 2020 at 1:01
You may want to refer to this question if you want 2D array of the filtered visible cells. Here is a similar approach as Ron's for area of the filtered range. — Naresh
– Naresh, Commented Jun 9, 2020 at 14:08

Ron Rosenfeld · Accepted Answer · 2020-06-09 13:58:50Z

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 9, 2020 at 13:58

answered Jun 9, 2020 at 1:07

Ron Rosenfeld

62k7 gold badges35 silver badges71 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

excelguy Over a year ago

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?

Ron Rosenfeld Over a year ago

@excelguy How did you Set rFiltered? The technique I showed in my answer works here.

excelguy Over a year ago

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?

Ron Rosenfeld Over a year ago

@excelguy I suppose you could either do them one at a time; or hide B:AH and AF:AJ before executing Set rFiltered = …

EvR · Accepted Answer · 2020-06-10 08:10:25Z

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, 2020 at 8:10

answered Jun 9, 2020 at 10:08

EvR

3,5082 gold badges17 silver badges25 bronze badges

3 Comments

T.M. Over a year ago

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

EvR Over a year ago

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.

T.M. Over a year ago

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

Collectives™ on Stack Overflow

VBA, Storing filtered values in array

2 Answers 2

4 Comments

3 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

3 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related