How do I do a transpose array in VBA? - excel

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

Answer 1

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