Rearrange my numbers

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
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

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
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
Eric W said:
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.
Click to expand...
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
Rick Rothstein said:
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]
Click to expand...
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
Rick Rothstein said:
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]
Click to expand...
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
motilulla said:
Nice Sub!! Rick, Thank you

Please can you check? It is not transposing last values (6 & 9) are find in column D & E
Click to expand...
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
Rick Rothstein said:
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]
Click to expand...
Great!! Rick, many thanks now it is running flawless!!

Have a good day

Regards,
Moti
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Rearrange data into two columns
Replies
3
Views
75
Fluff
Fluff
N
  • Solved
Rearrange columns based on number at top
Replies
5
Views
399
Nick70
N
A
  • Question Question
I need help with Active X buttons in VBA...
Replies
7
Views
150
angel44e
A
J
  • Question Question
Macro to rearrange spreadsheet
Replies
8
Views
499
jlister
J
S
  • Question Question
Copy certain column N number of times
Replies
0
Views
248
sm789
S

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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