Excel VBA Listrow to Array

Question

I have the below snippit for excel 2013 VBA

For Each r In rr
 If Not r.Range.Height = 0 Then
    FNum = FNum + 1
    ReDim Preserve testArr(1 To FNum, 1 To 23)
    testArr(FNum) = r
 End If

Next r

My goal is to get all the visible rows from a filtered table into an array.

The table can be any number of rows, but always 23 columns.

I found that the height will be zero if it is hidden. But for the life of me, I cannot figure out how to get the entire row into the array.

r = listrow rr = listrows

YES, I know a looping redim sucks.

SpecialCells(xlCellTypeVisible)

doesnt work either because it stops at the first hidden row/column.

I may just dump the entire table into the array and then filter the array. I havent figured out how to pull the active filter from the table to apply it, but I havent looked deeply into that yet. Thats what I will be doing now, because I am stuck for the other way.

Any and all advice is welcome.

DM

What is rr? I don't think your code can work as you wish anyway because Redim Preserve only resizes the last dimension. — SJR, Nov 29 '16 at 14:02

score 2 · Answer 1 · edited May 23 '17 at 12:30

2

To avoid REDIM or double loops you can use something like Application.WorksheetFunction.Subtotal(3, Range("A2:A500000")) to quickly count the number of visible rows.

See this question

edited May 23 '17 at 12:30

Community

1
1

answered Nov 29 '16 at 15:26

iDevlop

24,841
11
90
149

score 1 · Answer 2 · answered Nov 29 '16 at 15:34

I define my Target range using .SpecialCells(xlCellTypeVisible). Target.Cells.Count / Target.Columns.Count will give you the row count. Finally I iterate over the cells in the Target range incrementing my counters based off of the Target.Columns.Count.

Public Sub FilteredArray()
    Dim Data As Variant, r As Range, Target As Range
    Dim rowCount As Long, x As Long, y As Long

    Set Target = WorkSheets("Sheet1").ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible)

    If Not Target Is Nothing Then
        rowCount = Target.Cells.Count / Target.Columns.Count
        ReDim Data(1 To rowCount, 1 To Target.Columns.Count)
        x = 1
        For Each r In Target
            y = y + 1
            If y > Target.Columns.Count Then
                x = x + 1
                y = 1
            End If
            Data(x, y) = r.Value
        Next
    End If

End Sub

Ian · Answer 3 · 2016-11-29T16:38:55.913

The code below will create an array for all the rows and store each of these into another array that will store all info in sheet:

Function RowsToArray()
    Dim lastRow: lastRow = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Dim lastCol: lastCol = ActiveWorkbook.ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim newArr()
    ReDim newArr(lastRow)
    For r = 0 To lastRow - 1
        Dim rowarr()
        ReDim rowarr(lastCol)
        For c = 0 To lastCol - 1
            rowarr(c) = Cells(r + 1, c + 1).Value
        Next c
        newArr(r) = rowarr
    Next r
End Function

bobajob · Answer 4 · 2016-11-29T15:10:53.867

Can you loop over the cells in rr rather than the rows? If so, as @SJR says, you can only Redim Preserve the final dimension, so we're going to have to switch your dimensions. You can then use r.EntireRow.Hidden to check if we're in a visible row and increase the bound of your array by one if we are.

The following assumes that your data starts in column A:

For Each r In rr
    If Not r.EntireRow.Hidden Then
        If r.Column = 1 Then
            If UBound(testArr, 2) = 0 Then
                ReDim testArr(1 To 23, 1 To 1)
            Else
                ReDim Preserve testArr(1 To 23, 1 To UBound(testArr, 2) + 1)
            End If
        End If
        testArr(r.Column, UBound(testArr, 2)) = r
    End If
Next r

Edit:

Alternatively, you can keep using ListRows, but loop through twice, once to set the bounds of your array, and once to fill the array (which will have its own internal loop to run through the row...):

For Each r In rr
    If Not r.Range.Height = 0 Then
       Fnum = Fnum + 1
       ReDim testArr(1 To Fnum, 1 To 3)
    End If
Next r

Fnum = 0
For Each r In rr
    If Not r.Range.RowHeight = 0 Then
        Fnum = Fnum + 1
        dumarray = r.Range
        For i = 1 To 3
            testArr(Fnum, i) = dumarray(1, i)
        Next i
    End If
Next r

If the array hasn't been allocated yet then `If UBound(testArr, 2) = 0 Then` will throw a Type Mismatch Error. — , Nov 29 '16 at 14:58
Apologies, yes, I was assuming a `Dim testArr(1 to 3, 0 to 0)` earlier. — bobajob, Nov 29 '16 at 15:06

score 0 · Accepted Answer · answered Nov 29 '16 at 16:28

Thanks all, a combo of answers led me to: (not very elegant, but quick)

For Each r In rr
    If Not r.Range.Height = 0 Then
        TNum = TNum + 1
    End If
Next r

ReDim testArr(TNum, 23)

For Each r In rr
    If Not r.Range.Height = 0 Then
        FNum = FNum + 1
        For i = 1 To 23
            testArr(FNum, i) = r.Range.Cells(, i)
        Next i
    End If
Next r

Excel VBA Listrow to Array

5 Answers5