get entire row of array

Question

I have the following code below,

I want to get the entire row not just column 1 of the original array, how would i do this?

Sub Example1()
    Dim ar         


        

Answer 1

The ReDim statement can add records on-the-fly with the PRESERVE parameter but only into the last rank. This is a problem as the second rank of a two dimensioned array is typically considered the 'columns' while the first are the 'rows'.

The Application.Transpose can flip rows into columns and vise-versa but it has limitations. (see here and here)

A simple function to transpose without these limitations is actually very easy to build. All you really need are two arrays and two nested loops to flip them.

Sub Example1()
    Dim arrVALs() As Variant, arrPHONs() As Variant
    Dim v As Long, w As Long

    With Sheets("Raw Data").Cells(1, 1).CurrentRegion
        With .Resize(.Rows.Count - 1, 21).Offset(1, 0)
            arrVALs = .Cells.Value
            'array dimension check
            'Debug.Print LBound(arrVALs, 1) & ":" & UBound(arrVALs, 1)
            'Debug.Print LBound(arrVALs, 2) & ":" & UBound(arrVALs, 2)
            'Debug.Print Application.CountIf(.Columns(3), "phone") & " phones"
        End With
    End With

    ReDim arrPHONs(1 To UBound(arrVALs, 2), 1 To 1)
    For v = LBound(arrVALs, 1) To UBound(arrVALs, 1)
        If LCase(arrVALs(v, 3)) = "phone" Then
            For w = LBound(arrVALs, 2) To UBound(arrVALs, 2)
                arrPHONs(w, UBound(arrPHONs, 2)) = arrVALs(v, w)
            Next w
            ReDim Preserve arrPHONs(1 To UBound(arrPHONs, 1), _
                                    1 To UBound(arrPHONs, 2) + 1)
        End If
    Next v

    'there is 1 too many in the filtered array
    ReDim Preserve arrPHONs(1 To UBound(arrPHONs, 1), _
                            1 To UBound(arrPHONs, 2) - 1)

    'array dimension check
    'Debug.Print LBound(arrPHONs, 1) & ":" & UBound(arrPHONs, 1)
    'Debug.Print LBound(arrPHONs, 2) & ":" & UBound(arrPHONs, 2)

    'Option 1: use built-in Transpose
    'Worksheets("L").Range("A2:U" & UBound(arrPHONs, 2) + 1) = Application.Transpose(arrPHONs)

    'Option 2: use custom my_2D_Transpose
    Worksheets("L").Range("A2:U" & UBound(arrPHONs, 2) + 1) = my_2D_Transpose(arrPHONs)

End Sub

Function my_2D_Transpose(arr As Variant)
    Dim a As Long, b As Long, tmp() As Variant
    ReDim tmp(1 To UBound(arr, 2), 1 To UBound(arr, 1))
    For a = LBound(arr, 1) To UBound(arr, 1)
        For b = LBound(arr, 2) To UBound(arr, 2)
            tmp(b, a) = Trim(arr(a, b))
        Next b
    Next a
    my_2D_Transpose = tmp
End Function

So if you are in a hurry and the scope of your arrays is such that you will never reach the limits of Application.Transpose then by all means use it. If you cannot safely use transpose then use a custom function.