Vba code to rearrange data

A

ANTONIO1981

Board Regular
Joined
Apr 21, 2014
Messages
162
Hi All

i have this "table"

in sheet1 starts in cell A1

the mumber of rows will increase substantially as there other costs apart from Postage and courier


OTHER FIXED COSTS TABLE

<tbody>
</tbody>
Jan-18

<tbody>
</tbody>
Feb-18

<tbody>
</tbody>
Mar-18

<tbody>
</tbody>
Apr-18

<tbody>
</tbody>
May-18

<tbody>
</tbody>
Jun-18

<tbody>
</tbody>
Jul-18

<tbody>
</tbody>
Aug-18

<tbody>
</tbody>
Sep-18

<tbody>
</tbody>
Oct-18

<tbody>
</tbody>
Nov-18

<tbody>
</tbody>
Dec-18

<tbody>
</tbody>
Postage and courier

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>
347

<tbody>
</tbody>

<tbody>
</tbody>



i want to create a new "table" in Sheet 2 starting cell A1
following this style (in the example is only showing to February but i need all the moths obviously)


OTHER FIXED COSTS TABLE

<tbody>
</tbody>
MONTH

<tbody>
</tbody>
COST

<tbody>
</tbody>
Postage and courier

<tbody>
</tbody>
Jan-18

<tbody>
</tbody>
347

<tbody>
</tbody>
Postage and courier

<tbody>
</tbody>
Feb-18

<tbody>
</tbody>
347

<tbody>
</tbody>

<tbody>
</tbody>


thanks in advance

AC
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
You can use the following code.

Code: 
Sub transferXY()
Dim irow As Integer
Dim icolumn As Integer
Dim a As Worksheet
Dim b As Worksheet


Set a = Sheets("sheet1")
Set b = Sheets("sheet2")
b.Cells(1, 1) = a.Cells(1, 1)
b.Cells(1, 2) = "Month"
b.Cells(1, 3) = "Cost"
For irow = 1 To 12
    b.Cells(irow + 1, 1) = a.Cells(2, 1)
    For icolumn = 1 To 12
        b.Cells(irow + 1, icolumn + 1) = a.Cells(icolumn, irow + 1)
    Next
Next


End Sub

If you need to transfer more value, change both 12 in the two loop if you need a bigger range.

There is an Excel tool to do something like this, but I personally don't recommend it as it create some problem for me in the past.
 
Upvote 0
hi your code doen't work well


sheet1=where data is populated:







OTHER FIXED COSTS TABLE		Jan-18Feb-18Mar-18Apr-18May-18Jun-18Jul-18Aug-18Sep-18Oct-18Nov-18Dec-18
Postage and courier 347 347 347 347 347 347 347 347 347 347 347 347
Environmental certificates 347 347 347 347 347 347 347 347 347 347 347 347
Operating licences 347 347 347 347 347 347 347 347 347 347 347 347
Stationery and printing 347 347 347 347 347 347 347 347 347 347 347 347
Termination of operators 347 347 347 347 347 347 347 347 347 347 347 347
Freight costs 347 347 347 347 347 347 347 347 347 347 347 347
Fines and penalties 347 347 347 347 347 347 347 347 347 347 347 347
Test and analyses 347 347 347 347 347 347 347 347 347 347 347 347
Mystery shopper incentives 347 347 347 347 347 347 347 347 347 347 347 347
External warehouse 347 347 347 347 347 347 347 347 347 347 347 347
Announcements for new operators 347 347 347 347 347 347 347 347 347 347 347 347
Hotel costs for school enrolment new operators 347 347 347 347 347 347 347 347 347 347 347 347
Service charge cash register 347 347 347 347 347 347 347 347 347 347 347 347
Case of damage 347 347 347 347 347 347 347 347 347 347 347 347
Miscellaneous 347 347 347 347 347 347 347 347 347 347 347 347

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




sheet2 has to display this:

OTHER FIXED COSTS TABLEMonthCost
Postage and courierJan-18347
Postage and courierFeb-18347
Postage and courierMar-18347
Postage and courierApr-18347
Postage and courierMay-18347
Postage and courierJun-18347
Postage and courierJul-18347
Postage and courierAug-18347
Postage and courierSep-18347
Postage and courierOct-18347
Postage and courierNov-18347
Postage and courierDec-18347
Environmental certificatesJan-18347
Environmental certificatesFeb-18347
Environmental certificatesMar-18347
Environmental certificatesApr-18347
Environmental certificatesMay-18347
Environmental certificatesJun-18347
Environmental certificatesJul-18347
Environmental certificatesAug-18347
Environmental certificatesSep-18347
Environmental certificatesOct-18347
Environmental certificatesNov-18347
Environmental certificatesDec-18347
Operating licencesJan-18347
Operating licencesFeb-18347
Operating licencesMar-18347
Operating licencesApr-18347
Operating licencesMay-18347
Operating licencesJun-18347
Operating licencesJul-18347
Operating licencesAug-18347
Operating licencesSep-18347
Operating licencesOct-18347
Operating licencesNov-18347
Operating licencesDec-18347
Stationery and printingJan-18347
Stationery and printingFeb-18347
Stationery and printingMar-18347
Stationery and printingApr-18347
Stationery and printingMay-18347
Stationery and printingJun-18347
Stationery and printingJul-18347
Stationery and printingAug-18347
Stationery and printingSep-18347
Stationery and printingOct-18347
Stationery and printingNov-18347
Stationery and printingDec-18347
Termination of operatorsJan-18347
Termination of operatorsFeb-18347
Termination of operatorsMar-18347
Termination of operatorsApr-18347
Termination of operatorsMay-18347
Termination of operatorsJun-18347
Termination of operatorsJul-18347
Termination of operatorsAug-18347
Termination of operatorsSep-18347
Termination of operatorsOct-18347
Termination of operatorsNov-18347
Termination of operatorsDec-18347
Freight costsJan-18347
Freight costsFeb-18347
Freight costsMar-18347
Freight costsApr-18347
Freight costsMay-18347
Freight costsJun-18347
Freight costsJul-18347
Freight costsAug-18347
Freight costsSep-18347
Freight costsOct-18347
Freight costsNov-18347
Freight costsDec-18347
Fines and penaltiesJan-18347
Fines and penaltiesFeb-18347
Fines and penaltiesMar-18347
Fines and penaltiesApr-18347
Fines and penaltiesMay-18347
Fines and penaltiesJun-18347
Fines and penaltiesJul-18347
Fines and penaltiesAug-18347
Fines and penaltiesSep-18347
Fines and penaltiesOct-18347
Fines and penaltiesNov-18347
Fines and penaltiesDec-18347
Test and analysesJan-18347
Test and analysesFeb-18347
Test and analysesMar-18347
Test and analysesApr-18347
Test and analysesMay-18347
Test and analysesJun-18347
Test and analysesJul-18347
Test and analysesAug-18347
Test and analysesSep-18347
Test and analysesOct-18347
Test and analysesNov-18347
Test and analysesDec-18347
Mystery shopper incentivesJan-18347
Mystery shopper incentivesFeb-18347
Mystery shopper incentivesMar-18347
Mystery shopper incentivesApr-18347
Mystery shopper incentivesMay-18347
Mystery shopper incentivesJun-18347
Mystery shopper incentivesJul-18347
Mystery shopper incentivesAug-18347
Mystery shopper incentivesSep-18347
Mystery shopper incentivesOct-18347
Mystery shopper incentivesNov-18347
Mystery shopper incentivesDec-18347
External warehouseJan-18347
External warehouseFeb-18347
External warehouseMar-18347
External warehouseApr-18347
External warehouseMay-18347
External warehouseJun-18347
External warehouseJul-18347
External warehouseAug-18347
External warehouseSep-18347
External warehouseOct-18347
External warehouseNov-18347
External warehouseDec-18347
Announcements for new operatorsJan-18347
Announcements for new operatorsFeb-18347
Announcements for new operatorsMar-18347
Announcements for new operatorsApr-18347
Announcements for new operatorsMay-18347
Announcements for new operatorsJun-18347
Announcements for new operatorsJul-18347
Announcements for new operatorsAug-18347
Announcements for new operatorsSep-18347
Announcements for new operatorsOct-18347
Announcements for new operatorsNov-18347
Announcements for new operatorsDec-18347
Hotel costs for school enrolment new operatorsJan-18347
Hotel costs for school enrolment new operatorsFeb-18347
Hotel costs for school enrolment new operatorsMar-18347
Hotel costs for school enrolment new operatorsApr-18347
Hotel costs for school enrolment new operatorsMay-18347
Hotel costs for school enrolment new operatorsJun-18347
Hotel costs for school enrolment new operatorsJul-18347
Hotel costs for school enrolment new operatorsAug-18347
Hotel costs for school enrolment new operatorsSep-18347
Hotel costs for school enrolment new operatorsOct-18347
Hotel costs for school enrolment new operatorsNov-18347
Hotel costs for school enrolment new operatorsDec-18347
Service charge cash registerJan-18347
Service charge cash registerFeb-18347
Service charge cash registerMar-18347
Service charge cash registerApr-18347
Service charge cash registerMay-18347
Service charge cash registerJun-18347
Service charge cash registerJul-18347
Service charge cash registerAug-18347
Service charge cash registerSep-18347
Service charge cash registerOct-18347
Service charge cash registerNov-18347
Service charge cash registerDec-18347
Case of damageJan-18347
Case of damageFeb-18347
Case of damageMar-18347
Case of damageApr-18347
Case of damageMay-18347
Case of damageJun-18347
Case of damageJul-18347
Case of damageAug-18347
Case of damageSep-18347
Case of damageOct-18347
Case of damageNov-18347
Case of damageDec-18347
MiscellaneousJan-18347
MiscellaneousFeb-18347
MiscellaneousMar-18347
MiscellaneousApr-18347
MiscellaneousMay-18347
MiscellaneousJun-18347
MiscellaneousJul-18347
MiscellaneousAug-18347
MiscellaneousSep-18347
MiscellaneousOct-18347
MiscellaneousNov-18347
MiscellaneousDec-18347

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

thanks in advance
 
Upvote 0
OOOO, I didn't know you had all that data in which format you wanted them.

In that case, use this
Code: 
Sub transferXY()
Dim irow As Integer
Dim icolumn As Integer
Dim a As Worksheet
Dim b As Worksheet




Set a = Sheets("sheet1")
Set b = Sheets("sheet2")
b.Cells(1, 1) = a.Cells(1, 1)
b.Cells(1, 2) = "Month"
b.Cells(1, 3) = "Cost"


For irow = 1 To 15
    For icolumn = 1 To 12
        b.Cells((irow - 1) * 12 + icolumn + 1, 1) = a.Cells(irow + 1, 1)
        b.Cells((irow - 1) * 12 + icolumn + 1, 2) = a.Cells(1, icolumn + 1)
        b.Cells((irow - 1) * 12 + icolumn + 1, 3) = a.Cells(irow + 1, icolumn + 1)
    Next
Next




End Sub
 
Upvote 0
it is working for the current data but if i increase the number of rows in sheet one doesn't work . the number of rows in sheet 1 can increase substantially....
 
Last edited:
Upvote 0
Try this.
I put the result in sheet2.

Please use Code Tags when posting a code. Like this: [CODE ]Your Code Here[/ CODE]
Code: 
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1018562a[B]()[/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] ra [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B][B],[/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B][B],[/B] j [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B][B],[/B] n [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] va[B],[/B] qa[B],[/B] vb[B],[/B] vc[B],[/B] qc
ra [B]=[/B] Range[B]([/B][B][COLOR=brown]"A"[/COLOR][/B] [B]&[/B] Rows.count[B]).[/B][B][COLOR=Royalblue]End[/COLOR][/B][B]([/B]xlUp[B]).[/B]row
va [B]=[/B] Range[B]([/B][B][COLOR=brown]"A2:A"[/COLOR][/B] [B]&[/B] ra[B])[/B]
[B][COLOR=Royalblue]ReDim[/COLOR][/B] qa[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] UBound[B]([/B]va[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B] [B]*[/B] [B][B][COLOR=crimson]12[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B])[/B]
 
vb [B]=[/B] Range[B]([/B]Cells[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B]),[/B] Cells[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]13[/COLOR][/B][/B][B]))[/B]
vc [B]=[/B] Range[B]([/B]Cells[B]([/B][B][B][COLOR=crimson]2[/COLOR][/B][/B][B],[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B]),[/B] Cells[B]([/B]ra[B],[/B] [B][B][COLOR=crimson]13[/COLOR][/B][/B][B]))[/B]
 
[B][COLOR=Royalblue]ReDim[/COLOR][/B] qc[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] UBound[B]([/B]vc[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B] [B]*[/B] UBound[B]([/B]vc[B],[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B]),[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B]
 
    [B][COLOR=Royalblue]For[/COLOR][/B] i [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] UBound[B]([/B]va[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B]
        [B][COLOR=Royalblue]For[/COLOR][/B] j [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] [B][B][COLOR=crimson]12[/COLOR][/B][/B]
        n [B]=[/B] n [B]+[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
            qa[B]([/B]n[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B] [B]=[/B] va[B]([/B]i[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B]
            qa[B]([/B]n[B],[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B])[/B] [B]=[/B] vb[B]([/B][B][B][COLOR=crimson]1[/COLOR][/B][/B][B],[/B] j[B])[/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
    [B][COLOR=Royalblue]Next[/COLOR][/B]
   
     [B][COLOR=Royalblue]For[/COLOR][/B] i [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] UBound[B]([/B]vc[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B]
        [B][COLOR=Royalblue]For[/COLOR][/B] j [B]=[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B] [B][COLOR=Royalblue]To[/COLOR][/B] UBound[B]([/B]vc[B],[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B])[/B]
            k [B]=[/B] k [B]+[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B]
            qc[B]([/B]k[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B] [B]=[/B] vc[B]([/B]i[B],[/B] j[B])[/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
    [B][COLOR=Royalblue]Next[/COLOR][/B]
 
[FONT=trebuchet ms][I][COLOR=Lightseagreen]'put the result in sheet2[/COLOR][/I][/FONT]
Sheets[B]([/B][B][COLOR=brown]"sheet2"[/COLOR][/B][B]).[/B]Activate
 
Range[B]([/B][B][COLOR=brown]"A2"[/COLOR][/B][B]).[/B]Resize[B]([/B]UBound[B]([/B]qa[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B]),[/B] [B][B][COLOR=crimson]2[/COLOR][/B][/B][B])[/B] [B]=[/B] qa
Range[B]([/B][B][COLOR=brown]"C2"[/COLOR][/B][B]).[/B]Resize[B]([/B]UBound[B]([/B]qc[B],[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B]),[/B] [B][B][COLOR=crimson]1[/COLOR][/B][/B][B])[/B] [B]=[/B] qc
 
[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
 
Upvote 0
How does it know that is in sheet1? i don;t want the macro to run in other sheets it is a big file..thanks in advance
 
Upvote 0
When you run the macro above sheet1 must be the activesheet OR you can add the blue line here:

Code: 
Dim va, qa, vb, vc, qc
 
[COLOR=#0000ff]Sheets("sheet1").Activate[/COLOR]
ra = Range("A" & Rows.count).End(xlUp).row
va = Range("A2:A" & ra)
 
Upvote 0
it works very well thanks! the only is if add an extra cost in sheet 1 , i run the macro and appears which is what has to do

however if i delete that cost from sheet 1 afterwards and run the macro again , the cost remains in sheet2

it should delete if possible. thanks in advance
 
Upvote 0
ANTONIO1981 said:
it works very well thanks! the only is if add an extra cost in sheet 1 , i run the macro and appears which is what has to do

however if i delete that cost from sheet 1 afterwards and run the macro again , the cost remains in sheet2

it should delete if possible. thanks in advance
Click to expand...

Do you mean you want to clear previous data in sheet2 every time you run the macro?
Add the blue line here:

Code: 
Sheets("sheet2").Activate
[COLOR=#0000ff]Cells.Clear[/COLOR]
Range("A2").Resize(UBound(qa, 1), 2) = qa
Range("C2").Resize(UBound(qc, 1), 1) = qc
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
suggest excel formula to calculate cumulative interest on no of days etc ......
Replies
1
Views
281
Peter_SSs
Peter_SSs
F
  • Solved
Allocation of cost to value of savings.
Replies
4
Views
155
fayo2009
F
nburaq
  • Solved
Conditional Formatting last n rows as data entered
Replies
6
Views
89
Fluff
Fluff
J
  • Question
adding cells based on criteria across several columns
Replies
5
Views
123
Cubist
Cubist
V
  • Solved
Week Number
Replies
2
Views
143
vmjan02
V

Forum statistics

Threads
1,215,724
Messages
6,126,482
Members
449,316
Latest member
sravya

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