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.22484



'************************************************************************

'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