How do I do a transpose array in VBA?

Question

so I have an assignment where I need to create a VBA array function called ShiftVector(rng,n) with arguments for a range (rng) and n that will shift the elements of an (m x 1) vector up by n rows. The first n rows of the range rng will “wrap around” and appear at the bottom of the resulting vector.

It's working on the locals window but its not working properly on excel, can some one help me?

Option Explicit
Option Base 1

Function ShiftVector(rng As Range, n As Integer)
Dim i As Integer, nr As Integer, B() As Variant
nr = rng.Rows.Count

ReDim B(nr, 1) As Variant

For i = 1 To nr - n
    B(i, 1) = rng.Cells(i + n, 1)
Next i

For i = nr - n + 1 To nr
    B(i, 1) = rng.Cells(i - nr + n, 1)
Next i

ShiftVector = Application.WorksheetFunction.Transpose(B)
End Function

VBasic2008 VBasic2008 · Accepted Answer · 2020-10-06T23:38:56

Shift Vector

To increase efficiency, it is better to write the values from the range rng to a 2D one-column one-based array D.
Then loop the array instead of the range and directly write to a 1D array B, so there will be no need for Transpose.
The result is a 1D one-based array.

The Code

Option Explicit

Function ShiftVector(rng As Range, n As Long) As Variant
    
    If rng Is Nothing Then
        GoTo ProcExit
    End If
    
    If n < 1 Or n > rng.Rows.Count Then
        GoTo ProcExit
    End If
    
    Dim D As Variant
    If rng.Rows.Count > 1 Then
        D = rng.Columns(1).Value
    Else
        ReDim D(1 To 1, 1 To 1)
        D(1, 1) = rng.Columns(1).Value
    End If
    
    Dim nr As Long
    nr = UBound(D, 1)
    
    Dim B As Variant
    ReDim B(1 To nr)
    
    Dim i As Long
    For i = 1 To nr - n
        B(i) = D(i + n, 1)
    Next i
    For i = nr - n + 1 To nr
        B(i) = D(i - nr + n, 1)
    Next i
    
    ShiftVector = B

ProcExit:
End Function

Sub testShiftVector()
    Debug.Print Join(ShiftVector(Range("A1:A10"), 3), vbLf)
End Sub

If you want a 2D one-based one-column array as the result use the following:

The Code

Function ShiftVector2D(rng As Range, n As Long) As Variant
    
    If rng Is Nothing Then
        GoTo ProcExit
    End If
    
    If n < 1 Or n > rng.Rows.Count Then
        GoTo ProcExit
    End If
    
    Dim D As Variant
    If rng.Rows.Count > 1 Then
        D = rng.Columns(1).Value
    Else
        ReDim D(1 To 1, 1 To 1)
        D(1, 1) = rng.Columns(1).Value
    End If
    
    Dim nr As Long
    nr = UBound(D, 1)
    
    Dim B() As Variant
    ReDim B(1 To nr, 1 To 1) As Variant
    
    Dim i As Long
    For i = 1 To nr - n
        B(i, 1) = D(i + n, 1)
    Next i
    For i = nr - n + 1 To nr
        B(i, 1) = D(i - nr + n, 1)
    Next i
    
    ShiftVector2D = B

ProcExit:
End Function

Sub testShiftVector2D()
    Dim Data As Variant
    Data = ShiftVector2D(Range("A1:A10"), 3)
    Dim i As Long
    For i = 1 To UBound(Data)
        Debug.Print Data(i, 1)
    Next i
    ' Or:
    'Range("B1").Resize(UBound(Data, 1)).Value = Data
End Sub

How do I do a transpose array in VBA?

1 Answers

Shift Vector