VBA Transpose Array

This tutorial will teach you how to transpose an array using VBA.

Transpose Array

This function will Transpose a 2-dimensional array:

Function TransposeArray(MyArray As Variant) As Variant
    Dim x As Long, y As Long
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    
    Dim tempArr As Variant
    
    'Get Upper and Lower Bounds
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Create New Temp Array
    ReDim tempArr(minY To maxY, minX To maxX)
    
    'Transpose the Array
    For x = minX To maxX
        For y = minY To maxY
            tempArr(y, x) = MyArray(x, y)
        Next y
    Next x
    
    'Output Array
    TransposeArray = tempArr
    
End Function

Sub TestTransposeArray()
    Dim testArr(1 To 3, 1 To 2) As Variant
    Dim outputArr As Variant
    
    'Assign Array Values
    testArr(1, 1) = "Steve"
    testArr(1, 2) = "Johnson"
    testArr(2, 1) = "Ryan"
    testArr(2, 2) = "Johnson"
    testArr(3, 1) = "Andrew"
    testArr(3, 2) = "Scott"
    
    'Call Transpose Function
    outputArr = TransposeArray(testArr)
    
    'Test Output
    MsgBox outputArr(2, 1)

End Sub

To test this function, call the procedure TestTransposeArray: here an initial array testArr is created and outputArr is the final transposed array.

WorksheetFunction.Transpose

Instead, you might want to transpose an array to Excel. To do so, you can use the Excel Transpose Worksheet Function.

This procedure will transpose a 2D array to an Excel range using the Transpose Worksheet Function:

Sub TestTransposeArray_Worksheetfx()
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    
    'Create Array and Assign Values
    Dim MyArray(1 To 3, 1 To 2) As Variant
    
    MyArray(1, 1) = "Steve"
    MyArray(1, 2) = "Johnson"
    MyArray(2, 1) = "Ryan"
    MyArray(2, 2) = "Johnson"
    MyArray(3, 1) = "Andrew"
    MyArray(3, 2) = "Scott"
    
    'Get Upper and Lower Bounds
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Transpose Array to Excel
    Range("a1").Resize(maxY - minY + 1, maxX - minX + 1).Value = _
      Application.WorksheetFunction.Transpose(MyArray)

End Sub