Filtered Range to Array

[bradmsg]

Hello all,

Someone please put me out of my misery! I have tried various approaches but have been unable to get a filtered range to a 2D array. The bellow code only seems to be picking up the header row.

What I'm trying to do:
I have a pre filtered sheet. I would like to suck up only the visible rows of data and paste them to a sheet 2.

problems:

while the select statement i have in here for debugging is selecting the correct cells , rng.Rows.count is returning a 1

Can someone please point out where this is going wrong?

thank you!

Private Sub grabResults_Click()
         
      Dim ws As Worksheet
      Set ws = Sheets("Sheet1")
         
    With ws
   
   
'    With ws.Range("A13:W13")
'
'        .AutoFilter Field:=7, Criteria1:=">0"
'
'    End With
   
Dim rng As Range
Dim rng1 As Range
Dim rngArea As Range
Dim ar As Variant
Dim sh As Worksheet
Dim i As Long
Dim j As Long

    RowCount = ws.Range("A" & Rows.count).End(xlUp).Row
   
    Set rng1 = ws.Range("A13:W" & RowCount)
   
    Set rng = rng1.SpecialCells(xlCellTypeVisible)
    'rng.Select 'for debugging, this is selecting the correct cells...


Set sh = ws

ReDim ar(1 To rng.Rows.count, 1 To 23) ' rng.Rows.count is returning a 1

    For Each rngArea In rng.Areas
        For Each rng1 In rngArea
            i = i + 1
            For j = 0 To 22
                ar(i, 1 + j) = rng1.Offset(0, j)
            Next j
        Next rng1
    Next rngArea
Sheet2.Range("A1").Resize(UBound(ar), 4) = ar

End sub

 

[rondeondo]

Hi Brad,
I've had a few encounters with macros working on filtered rows, for me the secret is to add a condition looking at the row height in your for loop. When a row is not shown it's not hidden but has a row height of 0. Add an if row.height<>0 before adding the cell contents to your array. The offset in the loop will ignore the specific rows you have selected.

 

[DanteAmor]

Hello @bradmsg. Thanks for posting on MrExcel board.

I think one rng is enough to read cell by cell and pass the data to an array. Of course, if that's the goal, use an array, and then download the array to the cells.
Try this:

Private Sub grabResults_Click()
  Dim ws As Worksheet
  Dim rng As Range, c As Range
  Dim i As Long, j As Long, k As Long, counter As Long, ini As Long
  Dim a As Variant
 
  Set ws = Sheets("Sheet1")
  Set rng = ws.Range("A13:W" & ws.Range("A" & Rows.Count).End(xlUp).Row)
  counter = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
  ReDim a(1 To counter, 1 To 23)
  ini = rng.Cells(1).Row
 
  With rng.SpecialCells(xlCellTypeVisible)
    For Each c In .Rows
      i = c.Row - ini + 1
      k = k + 1
      For j = 1 To 23
        a(k, j) = .Cells(i, j).Value
      Next
    Next
  End With
 
  Sheet2.Range("A1").Resize(k, 23) = a
End Sub

----- --

But if the goal is to copy the cell range you filter, then copy and paste is enough, try the following:

Private Sub grabResults_Click()
  Sheets("Sheet1").Range("A13:W" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row).Copy
  Sheet2.Range("A1").PasteSpecial xlPasteValues
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[Mario_R]

Greetings to all.
What if instead of "complicating your life" with the Autofilter you use the Advanced Filter?... For example like this:

Sub grabResults_Click()
Dim Rng As Range
With Sheets("Sheet1")
  Set Rng = .Range(.Cells(Rows.Count, "A").End(xlUp), "W13")
End With
With Sheets("Sheet2")
  .[a3].CurrentRegion.Delete xlShiftUp
  .[a1].Clear: .[a2] = "=" & Rng(2, 7).Address(0, 0, external:=True) & " > 0"
  Rng.AdvancedFilter 2, .[a1:a2], .[a3], False
  .Rows("1:2").Delete
End With
End Sub

 

[kevin9999]

I note you have 365 - have you considered just using the Filter() function on sheet2 to return the values you're after?

 

[bradmsg]

Hi Brad,
I've had a few encounters with macros working on filtered rows, for me the secret is to add a condition looking at the row height in your for loop. When a row is not shown it's not hidden but has a row height of 0. Add an if row.height<>0 before adding the cell contents to your array. The offset in the loop will ignore the specific rows you have selected.

Awesome idea! Simple and straightforward. I will definitely add this in future projects. Thank you for the insight!

 

[bradmsg]

Hello @bradmsg. Thanks for posting on MrExcel board.

I think one rng is enough to read cell by cell and pass the data to an array. Of course, if that's the goal, use an array, and then download the array to the cells.
Try this:

Private Sub grabResults_Click()
  Dim ws As Worksheet
  Dim rng As Range, c As Range
  Dim i As Long, j As Long, k As Long, counter As Long, ini As Long
  Dim a As Variant
 
  Set ws = Sheets("Sheet1")
  Set rng = ws.Range("A13:W" & ws.Range("A" & Rows.Count).End(xlUp).Row)
  counter = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count
  ReDim a(1 To counter, 1 To 23)
  ini = rng.Cells(1).Row
 
  With rng.SpecialCells(xlCellTypeVisible)
    For Each c In .Rows
      i = c.Row - ini + 1
      k = k + 1
      For j = 1 To 23
        a(k, j) = .Cells(i, j).Value
      Next
    Next
  End With
 
  Sheet2.Range("A1").Resize(k, 23) = a
End Sub

----- --

But if the goal is to copy the cell range you filter, then copy and paste is enough, try the following:

Private Sub grabResults_Click()
  Sheets("Sheet1").Range("A13:W" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row).Copy
  Sheet2.Range("A1").PasteSpecial xlPasteValues
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

Dante,

Thank you for your input! I will give it a go on Monday! It was driving me nuts! I ended up just copying it but, I still wanted to figure it out.

B

 

[bradmsg]

Greetings to all.
What if instead of "complicating your life" with the Autofilter you use the Advanced Filter?... For example like this:

Sub grabResults_Click()
Dim Rng As Range
With Sheets("Sheet1")
  Set Rng = .Range(.Cells(Rows.Count, "A").End(xlUp), "W13")
End With
With Sheets("Sheet2")
  .[a3].CurrentRegion.Delete xlShiftUp
  .[a1].Clear: .[a2] = "=" & Rng(2, 7).Address(0, 0, external:=True) & " > 0"
  Rng.AdvancedFilter 2, .[a1:a2], .[a3], False
  .Rows("1:2").Delete
End With
End Sub

Mario,

Thank you for your reply. Mostly because your code flew right over my head. LOL but, I’m intrigued because it is short and I do like using the advanced filter. I have just found the set up to use it a bit of a pain. Would you mind adding some comments so that I can test?

B

 

[Mario_R]

... Would you mind adding some comments so that I can test?

See if the following is enough to guide you:

Sub grabResults_Click()
Dim Rng As Range
With Sheets("Sheet1")
'I determine the range of cells to filter, including the range titles:
  Set Rng = .Range(.Cells(Rows.Count, "A").End(xlUp), "W13")
End With
With Sheets("Sheet2")
'I remove any content from sheet 'Sheet2':
  .[a3].CurrentRegion.Delete xlShiftUp
  
'I set the filter criteria using a formula.
'In this mode, the first cell must be empty and the second cell must contain the formula.
  .[a1].Clear
  .[a2] = "=" & Rng(2, 7).Address(0, 0, external:=True) & " > 0"
  
'I apply the filter and delete the two auxiliary cells:
  Rng.AdvancedFilter 2, .[a1:a2], .[a3], False
  .Rows("1:2").Delete
End With
End Sub