Need Help for Rearranging Data with Macro or Formula

culyus

New Member
Joined
Jun 15, 2007
Messages
17
Hello All,

This might be very easy for some of you. I have a data sheet like below:

ID P1 P2 ... Pn
1 A
2 A B
3 B A .... C
.
.

So in each row there are different number of columns with values. Id like to arrange it into;

ID P Rank
1 A First
2 A First
2 B Last
3 B First
3 A 2
3 C Last

So the last column with a value will be labeled as last and the first as first and the rest with their ranks (relative column number to the first) or we can also say middle if it is easier to solve this way.

Many thanks for your help. If anything is not clear, Id love to explain more.


Cheers,
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Try this:-
Results Start Sheet(2) "A1".

Code:
[COLOR="Navy"]Sub[/COLOR] MG22Nov26
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] AcRng       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Col         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Txt         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Num         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Num = ActiveSheet.Range("A1").CurrentRegion.Count
    [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
        ReDim Ray(1 To Num, 1 To 3)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]Set[/COLOR] AcRng = Range(Range("B" & Dn.Row), Cells(Dn.Row, Columns.Count).End(xlToLeft))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Col [COLOR="Navy"]In[/COLOR] AcRng
            [COLOR="Navy"]If[/COLOR] Col.Column = 2 [COLOR="Navy"]Then[/COLOR]
                Txt = "First"
             [COLOR="Navy"]ElseIf[/COLOR] Col.Column = AcRng.Count + 1 [COLOR="Navy"]Then[/COLOR]
                Txt = "Last"
             [COLOR="Navy"]Else[/COLOR]
                Txt = Col.Column - 1
            [COLOR="Navy"]End[/COLOR] If
                c = c + 1
            Ray(c, 1) = Dn
            Ray(c, 2) = Col
            Ray(c, 3) = Txt
        [COLOR="Navy"]Next[/COLOR] Col
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
.Range("A1").Resize(, 3) = Array("ID", "P", "Rank")
.Range("A2").Resize(c, 3) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
My attempt:

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>  <SPAN style="color:#00007F">Dim</SPAN> a, b<br>  <SPAN style="color:#00007F">Dim</SPAN> rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> ub1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ub2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>  <br>  a = Range("A1").CurrentRegion.Value<br>  ub1 = <SPAN style="color:#00007F">UBound</SPAN>(a, 1)<br>  ub2 = <SPAN style="color:#00007F">UBound</SPAN>(a, 2)<br>  <SPAN style="color:#00007F">ReDim</SPAN> b(1 <SPAN style="color:#00007F">To</SPAN> ub1 * ub2, 1 <SPAN style="color:#00007F">To</SPAN> 3)<br>  b(1, 1) = "ID"<br>  b(1, 2) = "P"<br>  b(1, 3) = "Rank"<br>  k = 1<br>  <SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> ub1<br>    r = 0<br>    <SPAN style="color:#00007F">For</SPAN> j = 2 <SPAN style="color:#00007F">To</SPAN> ub2<br>      <SPAN style="color:#00007F">If</SPAN> a(i, j) <> "" <SPAN style="color:#00007F">Then</SPAN><br>        k = k + 1<br>        r = r + 1<br>        b(k, 1) = a(i, 1)<br>        b(k, 2) = a(i, j)<br>        b(k, 3) = IIf(j = 2, "First", r)<br>      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> j<br>    <SPAN style="color:#00007F">If</SPAN> r > 1 <SPAN style="color:#00007F">Then</SPAN> b(k, 3) = "Last"<br>  <SPAN style="color:#00007F">Next</SPAN> i<br>  Range("A1").Offset(, ub2 + 2).Resize(k, 3).Value = b<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0
Thank you very much Mick. Ray(c, 1) = Dn was highlighted in debug after I ran the macro. Does it require any special set up, like data should start with A1 etc? By the way I think I mislead by using P1, P2 etc as column headers. Actually there is no column header in the data. Thanks a lot.
 
Upvote 0
Thank you very much Peter. This is amazing. It works :) I thought it didnt work but I found the data in DS to DU columns. Could you also teach me what to change in macro to get this into a new sheet and for the others that are not "last" or "first", how to label as "middle" when needed. Thanks so much.

My attempt:

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>**<SPAN style="color:#00007F">Dim</SPAN> a, b<br>**<SPAN style="color:#00007F">Dim</SPAN> rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>**<SPAN style="color:#00007F">Dim</SPAN> ub1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ub2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>**<br>**a = Range("A1").CurrentRegion.Value<br>**ub1 = <SPAN style="color:#00007F">UBound</SPAN>(a, 1)<br>**ub2 = <SPAN style="color:#00007F">UBound</SPAN>(a, 2)<br>**<SPAN style="color:#00007F">ReDim</SPAN> b(1 <SPAN style="color:#00007F">To</SPAN> ub1 * ub2, 1 <SPAN style="color:#00007F">To</SPAN> 3)<br>**b(1, 1) = "ID"<br>**b(1, 2) = "P"<br>**b(1, 3) = "Rank"<br>**k = 1<br>**<SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> ub1<br>****r = 0<br>****<SPAN style="color:#00007F">For</SPAN> j = 2 <SPAN style="color:#00007F">To</SPAN> ub2<br>******<SPAN style="color:#00007F">If</SPAN> a(i, j) <> "" <SPAN style="color:#00007F">Then</SPAN><br>********k = k + 1<br>********r = r + 1<br>********b(k, 1) = a(i, 1)<br>********b(k, 2) = a(i, j)<br>********b(k, 3) = IIf(j = 2, "First", r)<br>******<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>****<SPAN style="color:#00007F">Next</SPAN> j<br>****<SPAN style="color:#00007F">If</SPAN> r > 1 <SPAN style="color:#00007F">Then</SPAN> b(k, 3) = "Last"<br>**<SPAN style="color:#00007F">Next</SPAN> i<br>**Range("A1").Offset(, ub2 + 2).Resize(k, 3).Value = b<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

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