sbReShape

If you like to reshape a one- or two-dimensional array you can use the UDF sbReShape shown below:

[Please notice that you need to enter this function as an array-function!]

Please read my Disclaimer.

Function sbReShape(v As Variant, _
    Optional bByRow As Boolean = True, _
    Optional lColumns As Long = 1) As Variant
'Reverse("moc.LiborPlus.www") PB 09-Oct-2012 V0.6
Dim vP As Variant, vI As Variant, vR As Variant
Dim i(1 To 2) As Long, j As Long
Dim k(1 To 2) As Long, rc(1 To 2) As Long

With Application.WorksheetFunction
vP = .Transpose(.Transpose(v))
End With

With Application.Caller
j = 2 + bByRow
If TypeName(Application.Caller) = "Range" Then
    rc(1) = .Columns.Count
    rc(2) = .Rows.Count
Else
    rc(1) = lColumns
    rc(2) = 1
End If
ReDim vR(1 To rc(1), 1 To rc(2))
i(1) = 1
i(2) = 1
For Each vI In v
    vR(i(3 - j), i(j)) = vI
    i(2) = i(2) + 1
    If i(2) > rc(j) Then
        i(2) = 1
        i(1) = i(1) + 1
        If i(1) > rc(3 - j) Then
            sbReShape = Application.WorksheetFunction.Transpose(vR)
            Exit Function
        End If
    End If
Next vI
fillcverrval:
vR(i(3 - j), i(j)) = CVErr(xlErrValue)
i(2) = i(2) + 1
If i(2) > rc(j) Then
    i(2) = 1
    i(1) = i(1) + 1
    If i(1) > rc(3 - j) Then
        sbReShape = Application.WorksheetFunction.Transpose(vR)
        Exit Function
    End If
End If
GoTo fillcverrval
End With
End Function

Last updated