Transposing Excel table using VBA

[bhrigu]

Hi all,

I am super new to VBA and have looked at trying to fix this code on my own for a while now. I am trying to use the below code to transpose a table in excel. The table has 522 rows and 2 columns. I need it to be transposed to 522 columns and 2 rows. Thank you so much for any help.Capture.JPG

'************************************************************************
'The code will work like this
'1) UnPivot the data on Sheet1
'2) Insert a New Sheet called Tranposed if not available in the workbook
'3) Place the output i.e. UnPivoted data on the Transposed Sheet.
'************************************************************************
Sub UnPivotData()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim x, y, i As Long, j As Long, n As Long
    'Assuming data is on a sheet called "Sheet1", change it if required
    Set wsSource = Sheets("Sheet1")
    x = wsSource.Cells(1).CurrentRegion.Value
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 2)
    For i = 2 To UBound(x, 1)
        For j = 2 To UBound(x, 2)
            If x(i, j) <> "" Then
                n = n + 1
                y(n, 1) = x(i, 1)
                y(n, 2) = x(i, j)
            End If
        Next
    Next
    On Error Resume Next
    Set wsDest = Sheets("Transposed")
    wsDest.Cells.Clear
    On Error GoTo 0
    If wsDest Is Nothing Then
        Sheets.Add(after:=wsSource).Name = "Transposed"
        Set wsDest = ActiveSheet
    End If
    'wsDest.Range("A1:B1").Value = Array("Number", "Deatils")
    wsDest.Range("A1").Resize(UBound(y), 550).Value = y
    wsDest.Range("A1").CurrentRegion.Borders.Color = vbBlack
    MsgBox "Data Transposed Successfully.", vbInformation, "Done!"
End Sub

[Paul_Hossler]

Moved from Testing area

[Paul_Hossler]

Wasn't clear which line was causing the error

This is still doing it with loops the way you had it, but you could use the TRANSPOSE() worksheet function with VBA, or Copy/PasteSpecial with Transpose also

Option Explicit
'************************************************************************
'The code will work like this
'1) UnPivot the data on Sheet1
'2) Insert a New Sheet called Tranposed if not available in the workbook
'3) Place the output i.e. UnPivoted data on the Transposed Sheet.
'************************************************************************
Sub UnPivotData()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim arySource() As Variant, aryDest() As Variant
    Dim r As Long, c As Long
   
    'Assuming data is on a sheet called "Sheet1", change it if required
    Set wsSource = Sheets("Sheet1")
    arySource = wsSource.Cells(1).CurrentRegion.Value
   
    'switch rows and columns
    ReDim aryDest(1 To UBound(arySource, 2), 1 To UBound(arySource, 1))
    
    For r = LBound(arySource, 1) To UBound(arySource, 1)
        For c = LBound(arySource, 2) To UBound(arySource, 2)
            aryDest(c, r) = arySource(r, c)
        Next c
    Next r
    On Error Resume Next
    Set wsDest = Sheets("Transposed")
    wsDest.Cells.Clear
    On Error GoTo 0
    If wsDest Is Nothing Then
        Sheets.Add(after:=wsSource).Name = "Transposed"
        Set wsDest = ActiveSheet
    End If
   
   wsDest.Range("A1").Resize(UBound(aryDest, 1), UBound(aryDest, 2)).Value = aryDest
       
   MsgBox "Data Transposed Successfully.", vbInformation, "Done!"
End Sub