Rearrange my numbers

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,355
Office Version
  1. 2010
Hello,

I need to rearrange the column D & E numbers in the column G & H as per example attached below.

Example explain rearrange column D number in column G same procedure will be followed by rearrange column E number in column H

Starting numbers is in D6 = 5 in this number (ADD 5 UPPER EMPTY ROWS) result 5+5 =10 copy this number to in column G row 10 in the cells G10

For the second number is in D7 = 12 (add last total 10 + 12) result 22 copy this number to in column G row 22 in the cells G22

For the third number is in D8 = 11 (add last total 22 + 11) result 23 copy this number to in column G row 33 in the cells G33

And continue till last number find in column D using same method as describe. And same for the column E

Sheet1 Example


Book1
ABCDEFGH
1
2
3
4
5JorTempEM1C1C2EM2R1R2
6170/71511
7270/71123
8370/71113
9470/7144
10570/71595
11670/715
12770/717
13870/716
14970/71
151070/71
161170/7111
171270/71
181370/71
191470/713
201570/71
211670/71
221770/71123
231870/71
241970/71
252070/71
262170/714
272270/71
282370/71
292470/71
302570/71
312670/71
322770/71
332870/7111
342970/71
353070/719
363170/71
373270/714
383370/71
393470/71
403570/71
413670/71
423770/715
433870/71
443970/71
454070/71
46171/725
47271/72
48371/72
49471/72
50571/72
51671/72
52771/72
53871/72
54971/727
551071/72
561171/72
571271/72
581371/72
591471/72
601571/726
611671/72
621771/72
631871/72
641971/72
652071/72
Sheet1


Thank you all
Excel 2000
Regards,
Moti
 

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)
A couple of options. If you want a formula solution, put this formula in G6

=IF(ROW()=LOOKUP(2,1/(G$5:G5<>""),ROW(G$5:G5))+INDEX(D$6:D$100,SUMPRODUCT(--(G$5:G5<>""))),INDEX(D$6:D$100,SUMPRODUCT(--(G$5:G5<>""))),"")

copy it to H6 and drag both down the columns as far as needed.

If you prefer a macro, try:

Code:
Sub PutVals()
Dim c As Long, LR As Long, r1 As Long, r2 As Long

    For c = 4 To 5
        LR = Cells(Rows.Count, c).End(xlUp).Row
        r2 = 5
        For r1 = 6 To LR
            r2 = r2 + Cells(r1, c)
            Cells(r2, c + 3) = Cells(r1, c)
        Next r1
    Next c
    
End Sub

Both tested in Excel 2000.
 
Upvote 0
A couple of options. If you want a formula solution, put this formula in G6

=IF(ROW()=LOOKUP(2,1/(G$5:G5<>""),ROW(G$5:G5))+INDEX(D$6:D$100,SUMPRODUCT(--(G$5:G5<>""))),INDEX(D$6:D$100,SUMPRODUCT(--(G$5:G5<>""))),"")

copy it to H6 and drag both down the columns as far as needed.

If you prefer a macro, try:

Code:
Sub PutVals()
Dim c As Long, LR As Long, r1 As Long, r2 As Long

    For c = 4 To 5
        LR = Cells(Rows.Count, c).End(xlUp).Row
        r2 = 5
        For r1 = 6 To LR
            r2 = r2 + Cells(r1, c)
            Cells(r2, c + 3) = Cells(r1, c)
        Next r1
    Next c
    
End Sub

Both tested in Excel 2000.
Great!! Eric, both the options are producing results as required.

Thank you for the support.

Regards,
Moti
 
Upvote 0
Here is another macro that you can consider...
Code:
[table="width: 500"]
[tr]
	[td]Sub PutVals()
  Range("G6:G" & Application.Sum([D:D])) = Application.Transpose(Split(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",REPT("","",@-1)&@)", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row))), ","), ","))
  Range("H6:H" & Application.Sum([E:E])) = Application.Transpose(Split(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",REPT("","",@-1)&@)", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row))), ","), ","))
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Here is another macro that you can consider...
Code:
[table="width: 500"]
[tr]
	[td]Sub PutVals()
  Range("G6:G" & Application.Sum([D:D])) = Application.Transpose(Split(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",REPT("","",@-1)&@)", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row))), ","), ","))
  Range("H6:H" & Application.Sum([E:E])) = Application.Transpose(Split(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",REPT("","",@-1)&@)", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row))), ","), ","))
End Sub[/td]
[/tr]
[/table]
It just occurred to me that I can make those code lines slightly shorter (about 20 characters or so each)...
Code:
[table="width: 500"]
[tr]
	[td]Sub PutVals()
  Range("G6:G" & Application.Sum([D:D])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row)))))
  Range("H6:H" & Application.Sum([E:E])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row)))))
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
It just occurred to me that I can make those code lines slightly shorter (about 20 characters or so each)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub PutVals()
  Range("G6:G" & Application.Sum([D:D])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row)))))
  Range("H6:H" & Application.Sum([E:E])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row)))))
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]
Nice Sub!! Rick, Thank you

Please can you check? It is not transposing last values (6 & 9) are find in column D & E

Regards,
Moti
 
Last edited:
Upvote 0
Nice Sub!! Rick, Thank you

Please can you check? It is not transposing last values (6 & 9) are find in column D & E
Sorry, I completely missed that I had not made the receiving range (left side of the code line) large enough to recieve all of the values that the right side of the code line calculated. Here is the corrected code that now includes all of the values...
Code:
[table="width: 500"]
[tr]
	[td]Sub PutVals()
  Range("G6").Resize(Application.Sum([D:D])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row)))))
  Range("H6").Resize(Application.Sum([E:E])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row)))))
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Sorry, I completely missed that I had not made the receiving range (left side of the code line) large enough to recieve all of the values that the right side of the code line calculated. Here is the corrected code that now includes all of the values...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub PutVals()
  Range("G6").Resize(Application.Sum([D:D])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "D6:D" & Cells(Rows.Count, "D").End(xlUp).Row)))))
  Range("H6").Resize(Application.Sum([E:E])) = Application.Transpose(Split(Join(Evaluate(Replace("TRANSPOSE(IF(@="""","""",REPT("" "",@-1)&@))", "@", "E6:E" & Cells(Rows.Count, "E").End(xlUp).Row)))))
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]
Great!! Rick, many thanks now it is running flawless!!

Have a good day

Regards,
Moti
 
Upvote 0

Forum statistics

Threads
1,213,565
Messages
6,114,337
Members
448,568
Latest member
Honeymonster123

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