bhrigu

06-27-2018, 03:21 PM

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

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