Optimize/ Simplify Macro

lightkerosene

New Member
Joined
Sep 30, 2015
Messages
15
Code:
Sub Import()
Application.ScreenUpdating = False
'Import basic stuff
'Network
Sheet8.Range("U2:U3001") = Sheet3.Range("AB2:AB3001").Value
'Network Addon
Sheet2.Range("I5:I3004") = Sheet8.Range("V2:V3001").Value
'FAN
Sheet2.Range("B5:B3004") = Sheet3.Range("A2:A3001").Value
'BAN
Sheet2.Range("C5:C3004") = Sheet3.Range("E2:E3001").Value
'Phone Number
Sheet2.Range("D5:D3004") = Sheet3.Range("Q2:Q3001").Value
'End Date
Sheet2.Range("E5:E3004") = Sheet3.Range("I2:I3001").Value
'Make
Sheet2.Range("F5:F3004") = Sheet3.Range("AC2:AC3001").Value
'Model
Sheet2.Range("G5:G3004") = Sheet3.Range("AD2:AD3001").Value
'User
Sheet2.Range("H5:H3004") = Sheet3.Range("P2:P3001").Value
'Primary Line
Sheet2.Range("Q5:Q3004") = Sheet3.Range("X2:X3001").Value
'Minutes
Sheet2.Range("AQ5:AQ3004") = Sheet3.Range("AK2:AK3001").Value
'Data
Sheet2.Range("AR5:AR3004") = Sheet3.Range("AL2:AL3001").Value

'DragFormulas Paste
'Copy Row 2 to Row 3 through last data in Column U
     With Sheets("Macro Settings")
        .Rows("2:2").Copy
        .Rows("3:" & Range("U2").End(xlDown).Row).PasteSpecial
     End With
'International
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
'Insuarance
Sheet2.Range("Y5:Y3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BA5:BA3004") = Sheet8.Range("A2:A3001").Value
'Enhanced Push to Talk
Sheet2.Range("AA5:AA3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BC5:BC3004") = Sheet8.Range("A2:A3001").Value
'AT&T MDM
Sheet2.Range("AB5:AB3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BDZ5:BD3004") = Sheet8.Range("A2:A3001").Value
'Forms
Sheet2.Range("AC5:AC3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BE5:BE3004") = Sheet8.Range("A2:A3001").Value
'Toggle
Sheet2.Range("AD5:AD3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BF5:BF3004") = Sheet8.Range("A2:A3001").Value
'MRAS
Sheet2.Range("AE5:AE3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BG5:BG3004") = Sheet8.Range("A2:A3001").Value
'Comet
Sheet2.Range("AF5:AF3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BH5:BH3004") = Sheet8.Range("A2:A3001").Value
'Airwatch
Sheet2.Range("AI5:AI3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BK5:BK3004") = Sheet8.Range("A2:A3001").Value
'AprivaPay
Sheet2.Range("AG5:AG3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BI5:BI3004") = Sheet8.Range("A2:A3001").Value
'Big Tin Can
Sheet2.Range("AL5:AL3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BN5:BN3004") = Sheet8.Range("A2:A3001").Value
'Box
Sheet2.Range("AM5:AM3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BO5:BO3004") = Sheet8.Range("A2:A3001").Value
'OAH
Sheet2.Range("AN5:AN3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BP5:BP3004") = Sheet8.Range("A2:A3001").Value
'Office Direct
Sheet2.Range("AO5:AO3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BQ5:BQ3004") = Sheet8.Range("A2:A3001").Value
'Access My LAN
Sheet2.Range("Z5:Z3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BB5:BB3004") = Sheet8.Range("A2:A3001").Value
'Business Messaging
Sheet2.Range("AP5:AP3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BR5:BR3004") = Sheet8.Range("A2:A3001").Value
'Xora
Sheet2.Range("AK5:AK3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BM5:BM3004") = Sheet8.Range("A2:A3001").Value
'TeleNAV
Sheet2.Range("AJ5:AJ3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("BL5:BL3004") = Sheet8.Range("A2:A3001").Value
'Unlimited Data
Sheet2.Range("X5:X3004") = Sheet8.Range("A2:A3001").Value
Sheet2.Range("AZ5:AZ3004") = Sheet8.Range("A2:A3001").Value
Application.ScreenUpdating = True
End Sub

So basically it is a copy paste very specific stuff. But it takes like 30 minutes to do a 10 line account. Is there a way to optimize this.. I was thinking for example:

Sheet2.Range("B5", Range("A2".End(xlDown)) = Sheet3.Range("A2", Range("A2".End(xlDown)).Value

But I have no idea how to write it correctly and make it work for this many copy pastes.

Any Ideas would be appreciated.
 
I was wrong (I just tested it)... that single line of code does not work correctly (because there are non-contiguous ranges in it)... a small loop is necessary to handle each area in the non-contiguous range separately (but the code is still extremely quick). Sorry about that. Here is the correct code to replace the code that I quoted in my previous message)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]  Dim Ar As Range
  For Each Ar In Intersect(Sheet2.Rows("5:3004"), Sheet2.Range("X:AG,AJ:AP,AZ:BI,BK:BK,BN:BQ").EntireColumn).Areas
    Ar = Sheet8.Range("A2:A3001").Value
  Next[/TD]
[/TR]
</tbody>[/TABLE]

Edit Note: I had also forgotten the Sheet2 references (code above fixed).


So I apologize... I actually wrote the code wrong and gave you the right one. Yours does look good if I want multiples though. Maybe I should use it multiple times instead of referencing the other sheet? Would that be better?
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Okay I see what you're saying. So make a variable for each category right?
No, the one variable (Ar) is all you need... the For.Next loop takes care of assigning it the proper range with each iteration of the loop... the loop is iterating the contiguous areas of the non-contiguous overall range. The code I posted in Message #10 completely replaces the portion of your overall data that I posted in Message #8. When I get more time, I'll look into reducing your other code (assuming it can be reduced, that is), but the portion I did post about was easy because you were assigning the same thing to each column.
 
Last edited:
Upvote 0
No, the one variable (Ar) is all you need... the For.Next loop takes care of assigning it the proper range with each iteration of the loop... the loop is iterating the contiguous areas of the non-contiguous overall range. The code I posted in Message #10 completely replaces the portion of your overall data that I posted in Message #8. When I get more time, I'll look into reducing your other code (assuming it can be reduced, that is), but the portion I did post about was easy because you were assigning the same thing to each column.


Yeah that was my bad... That calculations tip seems to help a bit... but I am thinking of a way to do the formula part.
 
Upvote 0

Forum statistics

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

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