Transpose Data based on row records

earthworm

earthworm

Well-known Member
Joined
May 19, 2009
Messages
759
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hi Have data like below

Information 1Information 2Information 3Information 4Information 5Reference 1Reference 2Reference 3Reference 4Reference 5
Info1Info9Info17Info25Info33A1A2
Info2Info10Info18Info26Info34B1
Info3Info11Info19Info27Info35C1C2C3
Info4Info12Info20Info28Info36D1D2D3D4
Info5Info13Info21Info29Info37E1
Info6Info14Info22Info30Info38F1F2F3F4F5
Info7Info15Info23Info31Info39G1G2
Info8Info16Info24Info32Info40H1H2H3

<colgroup><col span="5"><col span="5"></colgroup><tbody>
</tbody>

I want the data to appear like this

Information 1Information 2Information 3Information 4Information 5Reference
Info1Info9Info17Info25Info33A1
Info1Info9Info17Info25Info33A2
Info2Info10Info18Info26Info34B1
Info3Info11Info19Info27Info35C1
Info3Info11Info19Info27Info35C2
Info3Info11Info19Info27Info35C3
Info4Info12Info20Info28Info36D1
Info4Info12Info20Info28Info36D2
Info4Info12Info20Info28Info36D3
Info4Info12Info20Info28Info36D4
Info5Info13Info21Info29Info37E1
Info6Info14Info22Info30Info38F1
Info6Info14Info22Info30Info38F2
Info6Info14Info22Info30Info38F3
Info6Info14Info22Info30Info38F4
Info6Info14Info22Info30Info38F5
Info7Info15Info23Info31Info39G1
Info7Info15Info23Info31Info39G2
Info8Info16Info24Info32Info40H1
Info8Info16Info24Info32Info40H2
Info8Info16Info24Info32Info40H3

<colgroup><col span="5"><col></colgroup><tbody>
</tbody>

I tired using the old pivot technique but it involves at-least 4-5 steps. is there any formula method ?

I want the record to duplicate based on the number of reference against each .
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Information 1Information 2Information 3Information 4Information 5Reference 1Reference 2Reference 3Reference 4Reference 5helper
Info1Info9Info17Info25Info33A1A22
Info2Info10Info18Info26Info34B11
Info3Info11Info19Info27Info35C1C2C33
Info4Info12Info20Info28Info36D1D2D3D44
Info5Info13Info21Info29Info37E11
Info6Info14Info22Info30Info38F1F2F3F4F55
Info7Info15Info23Info31Info39G1G22
Info8Info16Info24Info32Info40H1H2H33
I want the data to appear like this
Information 1Information 2Information 3Information 4Information 5Reference
Info1Info9Info17Info25Info33A1
Info1Info9Info17Info25Info33A2
Info2Info10Info18Info26Info34B1
Info3Info11Info19Info27Info35C1
Info3Info11Info19Info27Info35C2
Info3Info11Info19Info27Info35C3
this macro produces the lower table
Sub Macro4()
'
Info1Info9Info17Info25Info33A1' Macro4 Macro
Info1Info9Info17Info25Info33A2' Macro recorded 25/10/2017 by bob
Info2Info10Info18Info26Info34B1'
Info3Info11Info19Info27Info35C1
Info3Info11Info19Info27Info35C2'
Info3Info11Info19Info27Info35C3 rrow = 25
Info4Info12Info20Info28Info36D1 For j = 2 To 9
Info4Info12Info20Info28Info36D220 For z = 1 To Cells(j, 12)
Info4Info12Info20Info28Info36D3 Cells(rrow, 1) = Cells(j, 1)
Info4Info12Info20Info28Info36D4 Cells(rrow, 2) = Cells(j, 2)
Info5Info13Info21Info29Info37E1 Cells(rrow, 3) = Cells(j, 3)
Info6Info14Info22Info30Info38F1 Cells(rrow, 4) = Cells(j, 4)
Info6Info14Info22Info30Info38F2 Cells(rrow, 5) = Cells(j, 5)
Info6Info14Info22Info30Info38F3 Cells(rrow, 6) = Cells(j, 5 + z)
Info6Info14Info22Info30Info38F4 rrow = rrow + 1
Info6Info14Info22Info30Info38F5 Next z
Info7Info15Info23Info31Info39G1 Next j
Info7Info15Info23Info31Info39G2 End Sub
Info8Info16Info24Info32Info40H1
Info8Info16Info24Info32Info40H2
Info8Info16Info24Info32Info40H3

<colgroup><col><col><col span="2"><col><col><col span="8"></colgroup><tbody>
</tbody>
 
Upvote 0
Try this for results on sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG25Oct29
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nRay(1 To 6, 1 To 1)
    nRay(6, 1) = "Reference"
    [COLOR="Navy"]For[/COLOR] n = 1 To 5
         nRay(n, 1) = Ray(1, n)
    [COLOR="Navy"]Next[/COLOR] n
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 6 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Ray(n, Ac) <> "" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ReDim Preserve nRay(1 To 6, 1 To c)
            [COLOR="Navy"]For[/COLOR] nn = 1 To 5
                nRay(nn, c) = Ray(n, nn)
            [COLOR="Navy"]Next[/COLOR] nn
            nRay(6, c) = Ray(n, Ac)
       [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 6)
        .Value = Application.Transpose(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
Thanks . its working perfect.
 
Last edited:
Upvote 0
MickG said:
Try this for results on sheet2.
Code: 
[COLOR=Navy]Sub[/COLOR] MG25Oct29
[COLOR=Navy]Dim[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nn [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nRay(1 To 6, 1 To 1)
    nRay(6, 1) = "Reference"
    [COLOR=Navy]For[/COLOR] n = 1 To 5
         nRay(n, 1) = Ray(1, n)
    [COLOR=Navy]Next[/COLOR] n
c = 1
[COLOR=Navy]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR=Navy]For[/COLOR] Ac = 6 To UBound(Ray, 2)
        [COLOR=Navy]If[/COLOR] Ray(n, Ac) <> "" [COLOR=Navy]Then[/COLOR]
            c = c + 1
            ReDim Preserve nRay(1 To 6, 1 To c)
            [COLOR=Navy]For[/COLOR] nn = 1 To 5
                nRay(nn, c) = Ray(n, nn)
            [COLOR=Navy]Next[/COLOR] nn
            nRay(6, c) = Ray(n, Ac)
       [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 6)
        .Value = Application.Transpose(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...

Thanks for the code . Now suppose i need to adjust the code as per my own dimension i.e more information column before reference which part of code shall i play with
 
Last edited:
Upvote 0
Alter columns as appropriate to your new data where shown in Code Comments.

Code: 
[COLOR=navy]Sub[/COLOR] MG25Oct37
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nn [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nRay(1 To 6, 1 To 1) '[COLOR=green][B]>>6 is the last column in Array nRay.(Altert That)[/B][/COLOR]
    nRay(6, 1) = "Reference" '[COLOR=green][B]>>6 is the last column in Array nRay.(Altert That)[/B][/COLOR]
    For n = 1 To 5 '[COLOR=green][B]>> 5 is the last column before "Reference columns starts .(Alter that)[/B][/COLOR]
         nRay(n, 1) = Ray(1, n)
    [COLOR=navy]Next[/COLOR] n
c = 1
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
    For Ac = 6 To UBound(Ray, 2) '[COLOR=green][B]> 6 is the starting column for reference,"Alter that).[/B][/COLOR]
        [COLOR=navy]If[/COLOR] Ray(n, Ac) <> "" [COLOR=navy]Then[/COLOR]
            c = c + 1
            ReDim Preserve nRay(1 To 6, 1 To c) '[COLOR=green][B]> 6 is the number of columns in the "nRay" array. (Alter that)[/B][/COLOR]
                nRay(nn, c) = Ray(n, nn)
            [COLOR=navy]Next[/COLOR] nn
            nRay(6, c) = Ray(n, Ac) '[COLOR=green][B]6 is the last columns in "nRay" array.(Alter that)[/B][/COLOR]
       [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]Next[/COLOR] n
With Sheets("Sheet2").Range("A1").Resize(c, 6) '[COLOR=green][B]>6 is th final column in "nRay" array (Alter that)[/B][/COLOR]
        .Value = Application.Transpose(nRay)
        .Borders.Weight = 2
        .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Thanks for the clarity. You rock. Please also suggest is there also any formula technique
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy the missing cells from another workbook
Replies
4
Views
354
Max1616
M
C
  • Question
Match and retrieve values from another workbook
Replies
3
Views
369
Cortex1000
C
N
  • Question
Email hyperlink: reference cells in another table on specific row for each email.
Replies
0
Views
285
NehaDu
N

Forum statistics

Threads
1,215,616
Messages
6,125,860
Members
449,266
Latest member
davinroach

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