convert columns to rows

[Ty]

I have a problem with data in a MS Excel spreadsheet in a column. I need 15 columns converted to rows. On the column I need the header to repeat for every item within that column.

problem:
column abc
row 222
row 333
row 444
row 555
row 1236
row 2bca

solution needed:
col-1/col-2 as headers rows all down below
abc 222
abc 333
abc 444
abc 555
abc 1236
abc 2bca

Any help will be greatly appreciated,
Ty

 

[Abhijeet Gudur]

Hope this is useful..

Option Explicit
'assuming your table may have text or number
Sub transposee()

Dim lrow As Integer, i As Integer, t As Integer, z As Long
Dim sHead As String, sVal As String

Columns("W:W").ClearContents
lrow = Cells(Rows.Count, "A").End(xlUp).Row
z = 2
For i = 2 To 16 ' Here assumed that column A is not having data
sHead = Cells(1, i)
For t = 2 To lrow
sVal = Cells(t, i)
Cells(z, 23).Value = sHead & sVal ' values will appear in col W
z = z + 1
Next

Next
End Sub


column abc def ghi jkl mno int tint mint On the column need the header to
row 222 175 316 427 834 397 268 538 295 178 737 281 842 105 300
row 333 468 798 471 394 528 330 388 228 531 489 111 709 772 597
row 444 909 344 503 629 952 492 658 648 496 129 899 525 587 235
row 555 237 446 537 862 657 606 132 545 704 643 107 148 356 873
row 1236 567 558 682 118 517 855 737 734 521 590 815 161 523 593
row 345 282 497 467 121 690 986 627 803 721 117 567 205 646 579


got converted into

abc222
abc333
abc444
abc555
abc1236
abc345
def175
def468
def909
def237
def567
def282
ghi316
ghi798
ghi344
ghi446
ghi558
ghi497
jkl427
jkl471
jkl503
jkl537
jkl682
jkl467
mno834
mno394
mno629
mno862
mno118
mno121
int397
int528
int952
int657
int517
int690
tint268
tint330
tint492
tint606
tint855
tint986
mint538
mint388
mint658
mint132
mint737
mint627
On295
On228
On648
On545
On734
On803
the178
the531
the496
the704
the521
the721
column737
column489
column129
column643
column590
column117
need281
need111
need899
need107
need815
need567
the842
the709
the525
the148
the161
the205
header105
header772
header587
header356
header523
header646
to300
to597
to235
to873
to593
to579

 

[Ty]

Yes. That helps. What about placing the heading in column 1 and the other part in column 2?

Thanks,
Ty

 

[Abhijeet Gudur]

Possible ..

Option Explicit
'assuming your table may have text or number
Sub transposee()

Dim lrow As Integer, i As Integer, t As Integer, z As Long
Dim sHead As String, sVal As String

Columns("W:S").ClearContents
lrow = Cells(Rows.Count, "A").End(xlUp).Row
z = 2
For i = 2 To 16 ' Here assumed that column A is not having data
sHead = Cells(1, i)
For t = 2 To lrow
sVal = Cells(t, i)
Cells(z, 23).Value = sHead
Cells(z, 24).Value = sVal
z = z + 1
Next

Next
End Sub

OUTPUT -

abc 222
abc 333
abc 444
abc 555
abc 1236
abc 345
def 175
def 468
def 909
def 237
def 567
def 282
ghi 316
ghi 798
ghi 344
ghi 446
ghi 558
ghi 497
jkl 427
jkl 471
jkl 503
jkl 537
jkl 682
jkl 467
mno 834
mno 394
mno 629
mno 862
mno 118
mno 121
int 397
int 528
int 952
int 657
int 517
int 690
tint 268
tint 330
tint 492
tint 606
tint 855
tint 986
mint 538
mint 388
mint 658
mint 132
mint 737
mint 627
On 295
On 228
On 648
On 545
On 734
On 803
the 178
the 531
the 496
the 704
the 521
the 721
column 737
column 489
column 129
column 643
column 590
column 117
need 281
need 111
need 899
need 107
need 815
need 567
the 842
the 709
the 525
the 148
the 161
the 205
header 105
header 772
header 587
header 356
header 523
header 646
to 300
to 597
to 235
to 873
to 593
to 579

 

[Abhijeet Gudur]

Possible..
Option Explicit
'assuming your table may have text or number
Sub transposee()

Dim lrow As Integer, i As Integer, t As Integer, z As Long
Dim sHead As String, sVal As String

Columns("W:Y").ClearContents
lrow = Cells(Rows.Count, "A").End(xlUp).Row
z = 2
For i = 2 To 16 ' Here assumed that column A is not having data
sHead = Cells(1, i)
For t = 2 To lrow
sVal = Cells(t, i)
Cells(z, 23).Value = sHead
Cells(z, 24).Value = sVal
z = z + 1
Next
Next
End Sub


This is what you were looking for ..

abc 222
abc 333
abc 444
abc 555
abc 1236
abc 345
def 175
def 468
def 909
def 237
def 567
def 282
ghi 316
ghi 798
ghi 344
ghi 446
ghi 558
ghi 497
jkl 427
jkl 471
jkl 503
jkl 537
jkl 682
jkl 467
mno 834
mno 394
mno 629
mno 862
mno 118
mno 121
int 397
int 528
int 952
int 657
int 517
int 690
tint 268
tint 330
tint 492
tint 606
tint 855
tint 986
mint 538
mint 388
mint 658
mint 132
mint 737
mint 627
On 295
On 228
On 648
On 545
On 734
On 803
the 178
the 531
the 496
the 704
the 521
the 721
column 737
column 489
column 129
column 643
column 590
column 117
need 281
need 111
need 899
need 107
need 815
need 567
the 842
the 709
the 525
the 148
the 161
the 205
header 105
header 772
header 587
header 356
header 523
header 646
to 300
to 597
to 235
to 873
to 593
to 579

 

[Ty]

One more request. The problem currently have about 150 lines and might increase higher on any given week. How do I place the data in another sheet called "data"?

Thanks,
Ty

 

[Abhijeet Gudur]

No of rows is not a problem this automatically calculates last row and thenpublish the results.However this macro will read till 15 column.

Please test it, sorry, but i am very busy. Here is the code which will paste results in sheet called "data", if there is no tab called data it will throw an error(have not included error handler). Let me know if it works..

Sub transposee()

Dim lrow As Integer, i As Integer, t As Integer, z As Long
Dim sHead As String, sVal As String

Worksheets("Data").Columns("A:B").ClearContents
With Sheets(1)
lrow = Cells(Rows.Count, "A").End(xlUp).Row
z = 2
For i = 2 To 16 ' Here assumed that column A is not having data
sHead = Cells(1, i)
For t = 2 To lrow
sVal = Cells(t, i)
Worksheets("Data").Cells(z, 1).Value = sHead
Worksheets("Data").Cells(z, 2).Value = sVal
z = z + 1
Next
Next
End With
End Sub