Transpose and Repeat header

S

Snaybot

New Member
Joined
Apr 28, 2015
Messages
40
Im looking for a macro that transposes my header and repeats it and puts my new table column to paste right next to it until data is sufficiently filled out

I have this
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]5[/TD]
[TD]8[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]12[/TD]
[/TR]
</tbody>[/TABLE]

Regular Transposing gives me this
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]10[/TD]
[TD]11[/TD]
[TD]12[/TD]
[/TR]
</tbody>[/TABLE]



i want this
[TABLE="width: 250"]
<tbody>[TR]
[TD]A[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]D[/TD]
[TD]12[/TD]
[/TR]
</tbody>[/TABLE]


My table size will vary

Thank you!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Try this:-
Results start "H1"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG28Apr14
[COLOR="Navy"]Dim[/COLOR] Ray, nRay, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("A1").CurrentRegion
    ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        c = c + 1
        nRay(c, 1) = Ray(1, Ac)
        nRay(c, 2) = Ray(n, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
Range("H1").Resize(c, 2) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Sub MG28Apr14
Dim Ray, nRay, n As Long, c As Long, Ac As Long
Ray = Range("A1").CurrentRegion
ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 2)
For n = 2 To UBound(Ray, 1)
For Ac = 1 To UBound(Ray, 2)
c = c + 1
nRay(c, 1) = Ray(1, Ac)
nRay(c, 2) = Ray(n, Ac)
Next Ac
Next n

sheets("Sheet2").Range("A1").Resize(c,2)= nrayEnd Sub</pre>
 
Upvote 0
I've a Similar problem with an Addional condition.

I've This


[TABLE="width: 779"]
<tbody>[TR]
[TD]Product No[/TD]
[TD]TUV_Model[/TD]
[TD]TUV_OverallLength[/TD]
[TD]TUV_OverallWidth[/TD]
[TD]TUV_OverallHeight[/TD]
[TD]TUV_Wheelbase[/TD]
[TD]TUV_EngineCapacity[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]D1[/TD]
[TD]4520mm[/TD]
[TD]1850mm[/TD]
[TD]1880mm[/TD]
[TD]2760mm[/TD]
[TD]2489[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]D2[/TD]
[TD]4520mm[/TD]
[TD]1850mm[/TD]
[TD]1880mm[/TD]
[TD]2760mm[/TD]
[TD]2489[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]D3[/TD]
[TD]4520mm[/TD]
[TD]1850mm[/TD]
[TD]1880mm[/TD]
[TD]2760mm[/TD]
[TD]2489[/TD]
[/TR]
</tbody>[/TABLE]


I Want This

[TABLE="width: 335"]
<tbody>[TR]
[TD]Product 1[/TD]
[TD]TUV_Model[/TD]
[TD]D1[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]TUV_OverallLength[/TD]
[TD]4520mm[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]TUV_OverallWidth[/TD]
[TD]1850mm[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]TUV_OverallHeight[/TD]
[TD]1880mm[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]TUV_Wheelbase[/TD]
[TD]2760mm[/TD]
[/TR]
[TR]
[TD]Product 1[/TD]
[TD]TUV_EngineCapacity[/TD]
[TD="align: right"]2489[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_Model[/TD]
[TD]D2[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_OverallLength[/TD]
[TD]4520mm[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_OverallWidth[/TD]
[TD]1850mm[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_OverallHeight[/TD]
[TD]1880mm[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_Wheelbase[/TD]
[TD]2760mm[/TD]
[/TR]
[TR]
[TD]Product 2[/TD]
[TD]TUV_EngineCapacity[/TD]
[TD="align: right"]2489[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_Model[/TD]
[TD]D3[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_OverallLength[/TD]
[TD]4520mm[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_OverallWidth[/TD]
[TD]1850mm[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_OverallHeight[/TD]
[TD]1880mm[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_Wheelbase[/TD]
[TD]2760mm[/TD]
[/TR]
[TR]
[TD]Product 3[/TD]
[TD]TUV_EngineCapacity[/TD]
[TD="align: right"]2489[/TD]
[/TR]
</tbody>[/TABLE]


In addition to the above query I Just have Want to repeat value in column 1
 
Upvote 0
Kinngs:-
Try this for results on sheet2
Code: 
[COLOR="Navy"]Sub[/COLOR] MG13Jun05
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = Cells(1).CurrentRegion
 ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
 [COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        c = c + 1
        nray(c, 1) = Ray(n, 1)
        nray(c, 2) = Ray(1, Ac)
        nray(c, 3) = Ray(n, Ac)
     [COLOR="Navy"]Next[/COLOR] Ac
 [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thank You Mick, Superb!

MickG said:
Kinngs:-
Try this for results on sheet2
Code: 
[COLOR=Navy]Sub[/COLOR] MG13Jun05
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
 Ray = Cells(1).CurrentRegion
 ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
 [COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
        c = c + 1
        nray(c, 1) = Ray(n, 1)
        nray(c, 2) = Ray(1, Ac)
        nray(c, 3) = Ray(n, Ac)
     [COLOR=Navy]Next[/COLOR] Ac
 [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Transposing Columns to Rows
2
Replies
10
Views
194
Fluff
Fluff
S
  • Question Question
Macro to copy and paste special transpose that repeats after each blank row
Replies
3
Views
363
jolivanes
jolivanes
S
  • Solved
Repeating rows
Replies
2
Views
158
sharshra
S
N
  • Question Question
VBA Transpose & Join Help
Replies
5
Views
330
Alex Blakenburg
A
D
  • Question Question
Compile error: Wrong number of arguments or invalid property assignment
Replies
2
Views
55
daveyc18
D

Forum statistics

Threads
1,223,238
Messages
6,170,939
Members
452,368
Latest member
jayp2104

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top