[RESOLVED] recorded macro - execution time very long
Hello i am an amateur in macros, have recorded one macro made few changes but when run it is very time consuming it take 10+ mins to execute. can someone help me out regarding wat changes should i make to make it more fast and would be more of a professional code sortaf.
Below is my code
Code:
Sub below100()
Dim X As Long
NumRows = Range("A20", Range("A20").End(xlDown)).Rows.Count
'1. below100 Macro
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets("EVENING RAW").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("EVENING RAW").Sort.SortFields.Add Key:=Range( _
"T20:T5900"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("EVENING RAW").Sort
.SetRange Range("A19:BK5900")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("19:19").Select
Selection.AutoFilter
ActiveSheet.Range("$A$19:$Bz$65536").AutoFilter Field:=20, Criteria1:="<100" _
, Operator:=xlAnd
Range("T20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
'2 phase Delete Macro
Range("BL20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-62],PHASE!R12C2:R[64980]C[-62],1,0)"
ActiveCell.Offset(1, 0).Select
Next
Columns("BL:BL").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$19:$BZ$65536").AutoFilter Field:=64, Criteria1:= _
"<>#N/A", Operator:=xlAnd
Range("BL20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
'3 nottocall Macro
Range("BL20").Activate
Range("B20:B65536").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("B20"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon _
:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, _
1), TrailingMinusNumbers:=True
Selection.NumberFormat = "0.00000000"
Workbooks.Open Filename:= _
"\\inahdnas\FUNCTIONAL_DIR\BNC\CREDIT MONITORING\Dev\Not_To_ Call_ List.xls"
ThisWorkbook.Activate
Range("BL20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-62],'[Not_To_ Call_ List.xls]Sheet1'!R2C2:R65536C2,1,0)"
ActiveCell.Offset(1, 0).Select
Next
Windows("Not_To_ Call_ List.xls").Close
ThisWorkbook.Activate
Columns("BL:BL").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$19:$BL$12739").AutoFilter Field:=64, Criteria1:= _
"<>#N/A", Operator:=xlAnd
Range("BL20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
'4. Morning thresh
Range("BL20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-60],'MORNING RAW'!R20C4:R[13047]C[-44],17,0)"
ActiveCell.Offset(1, 0).Select
Next
Columns("BL:BL").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' diff
Range("BM20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = "=RC[-45]-RC[-1]"
ActiveCell.Offset(1, 0).Select
Next
Columns("BM:BM").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("BL:BL").Select
Selection.Delete Shift:=xlToLeft
Range(" BL19").Value = " % HIKE"
'5. Vlookup exp from morning
Range("BM20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-61],'MORNING RAW'!R20C4:R[65536]C[-49],13,0)"
ActiveCell.Offset(1, 0).Select
Next
Columns("BM:BM").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Exp. hike
Range("BN20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=RC[-1]-RC[-49]"
ActiveCell.Offset(1, 0).Select
Next
Columns("BN:BN").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("BM:BM").Select
Selection.Delete Shift:=xlToLeft
Range(" BM19").Value = " EXPOSURE HIKE"
'6. Delete <30% hike & <500 Rs exp hike excluding new cases
ActiveSheet.Range("$A$19:$BM$2948").AutoFilter Field:=64, Criteria1:="<=29" _
, Operator:=xlAnd
Range("BM19").Select
ActiveSheet.Range("$A$19:$BM$2948").AutoFilter Field:=65, Criteria1:= _
"<=499", Operator:=xlAnd
Range("BM20").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
'7. CITYTOZONE Mapping
Range(" BN19").Value = " ZONE "
Workbooks.Open Filename:= _
"\\inahdnas\FUNCTIONAL_DIR\BNC\CREDIT MONITORING\Dev\Cities to Zones1.xls"
ThisWorkbook.Activate
Range("BN20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-60],'[Cities to Zones1.xls]ar_ct'!R2C1:R65536C3,3,0)"
ActiveCell.Offset(1, 0).Select
Next
Windows("Cities to Zones1.xls").Close
ThisWorkbook.Activate
Columns("BN:BN").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'9. WATCHLIST Macro
Range(" BO19").Value = " WATCHLIST"
Workbooks.Open Filename:= _
"\\inahdnas\FUNCTIONAL_DIR\BNC\CREDIT MONITORING\Dev\Watchlist.xls"
ThisWorkbook.Activate
Range("Bo20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-65],[Watchlist.xls]Sheet1!R2C3:R65536C6,4,0)"
ActiveCell.Offset(1, 0).Select
Next
Windows("Watchlist.xls").Close
ThisWorkbook.Activate
Columns("BO:BO").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'10. ECSSI
Range(" BP19").Value = " ECS-SI"
Workbooks.Open Filename:= _
"\\inahdnas\FUNCTIONAL_DIR\BNC\CREDIT MONITORING\Dev\ECS-SI.xls"
ThisWorkbook.Activate
Range("BP20").Select
For X = 1 To NumRows
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-66],'[ECS-SI.xls]Sheet1'!R2C2:R65536C3,2,0)"
ActiveCell.Offset(1, 0).Select
Next
Windows("ECS-SI.xls").Close
ThisWorkbook.Activate
Columns("BP:BP").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub
i'm sorry this is very long but please if someone could help me with this.also is any declaration required in this??
Thanks in advance
Last edited by shailee; Jul 20th, 2009 at 11:47 PM.
Reason: added [code] tags
Hi zaza i could get you but couldnt implement it. in the code of mine could you give me one example where in we can consolidate this into "Range(X).Y" please. so that further i can correct it in this code.
Note that for your loops with ActiveCell.Offset , you do need the .Select beforehand, unless you re-write them. The one just after "'4. Morning thresh" could be re-written like this:
Code:
For X = 1 To NumRows
Range("BL" & 20+X).FormulaR1C1 = _
"=VLOOKUP(RC[-60],'MORNING RAW'!R20C4:R[13047]C[-44],17,0)"
Next
..which should be faster. It should be faster still to replace Range("BL" & 20+X) with Cells(20+X, 64)
However, as the value is exactly the same for all of the cells, the quickest way (if it works, I'm not entirely sure) should be to replace the loop with this:
hi, have done maximum i could do with all the help provided, still the execution time is high could some one please suggest some more ideas, please find the corrected code below
Note that a simple way to determine how long code takes (but only accurate to about a tenth of a second, and very wrong if midnight occurs while the code is running) is like this:
Code:
Dim StartTime as Single
StartTime = Timer
'your code here
MsgBox Round(Timer - StartTime, 2)
I don't use AutoFilter myself, but one thing I notice is that you are specifying a large range for the delete part - it will probably be quicker to specify the rows too, eg:
..you should then (and any other time you add/delete rows) determine NumRows again, as it is likely to have changed.
It may well be quicker (perhaps significantly) to replace the AutoFilter with loops to do the equivalent. Unfortunately I don't have enough knowledge of AutoFilter to work out quite what your current code is doing.
The VLOOKUP's could potentially be done in a quicker way, but I don't have much knowledge of them either.
I suspect a reasonably large part of the time is opening and closing the files, which could potentially be reduced if you could merge the files together (perhaps even into the same file as your code).
Assuming that would be a possibility, find out if it is worth looking into by seeing how long it takes to run only the relevant parts of your code:
The same applies to Rows/Columns/Cells, as they are also a kind of range.
ActiveCell is also a kind of range, so similar applies to that... but it also needs a cell to be activated, so it is better to avoid it. To do that, you could change this:
Code:
Range("BR20").Activate
Do
ThisWorkBook.Sheets("Sheet1").ActiveCell.FormulaR1C1 = ...
ThisWorkBook.Sheets("Sheet1").ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ThisWorkBook.Sheets("Sheet1").ActiveCell.Offset(0, -4))
...to this:
Code:
Dim rowNum as LongrowNum = 20
Do
ThisWorkBook.Sheets("Sheet1").Range("BR" & rowNum).FormulaR1C1 = ...
rowNum = rowNum + 1
Loop Until IsEmpty(ThisWorkBook.Sheets("Sheet1").Range("BN" & rowNum))
(it would be a little faster to use Cells rather than Range, but you would need to work out what the column numbers for BR and BN are)
I'm sorry but didn't understand. you could please give me ex. for each. like replace this from your code with this.
I gave you two examples of that - with highlighting to show which parts to add/change.
You should be able to use those examples to change not only the specific parts of your code that I showed, but the similar parts too - and maybe even work out how to do other parts which currently use .Activate
I can give you the answer but I want you to go through the code that I gave. I understand that you are a fresher but try and give it a shot... Understand how the code works... and then tell me what you tried. If there is an error, I will rectify it
Remember that's how we all (well most of us) learnt vb6/vba
A good exercise for the Heart is to bend down and help another up...
Please Mark your Thread "Resolved", if the query is solved
MyGear:
★ CPU ★ Ryzen 5 5800X
★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
★ Keyboard ★ TVS Electronics Gold Keyboard
★ Mouse ★ Logitech G502 Hero
There are two big reasons why that is the wrong approach.
Re-read this:
Originally Posted by koolsid
try and give it a shot... Understand how the code works... and then tell me what you tried. If there is an error, I will rectify it
The first reason for doing it that way is our time. We are helping you voluntarily in our own free time, and correcting your mistakes is much quicker for us than doing it all for you.
The second reason is that you don't learn anything. We are not here to do the work for you, but to help you do it yourself - and preferably get you to understand it too, so that next time you can do more of it by yourself. You can't learn from your mistakes if you don't know what they were - and we can't tell you what they were without seeing your code.
I know I am not the OP of this Thread, however, I found this possibly relevant to my own Macro. Is there a way to apply your method of Code to my Macro?
If ActiveSheet.Name = "DATA ACT" Or ActiveSheet.Name = "DATA REACT" Then
'Copies the Data (Service Number, Customer Name, SIM Number, IMEI Number)
Range("AE1:AH1").Copy
Range("BD1:BG1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
This is only a small section of my code (as an example). My code is much bigger and runs on IF statements based on which Sheet the User is on. It runs on a Workbook that is approximately 15,000 Rows Down and 56 Columns across. Its huge and the entire Macro will take up to 30 minutes to run. I have used all the other relevant "tips" which has helped tremendously (Took Up To 1 Hour or the Workbook would Crash).
This one just seems tricky for my code because the Sheet could be DATA ACT or DATA REACT. What I am asking basically is: Is there a way to implement your "TIP" without making 2 separate IF statements (one per sheet)?
The equivalent of ThisWorkBook.Sheets("Sheet1") would be ThisWorkBook.ActiveSheet (or if that gives an error, just ActiveSheet), which is effectively the same as you have already.
You implied that you have lots of If statements, presumably checking ActiveSheet.Name each time - in which case it would be best to store it in a String variable at the start of the routine, and then use the variable instead. If you repeat the same name checks, it would be best to store the result of the whole condition to a Boolean, and just use that in your If's instead.
There is an improvement that could be done in the code you showed, which is to provide the optional parameter to .Copy to tell it where to print. Instead of this:
As your code takes 30 minutes, there are probably other things too.. but it would be best to post your own thread for that to save confusion (if would probably help to link to this thread, and post a link to your thread in this one).
This will help me out a lot on several of my macros! Thank you.
As for posting my entire Macro....I am not sure if that is a good idea. It is:
1st Master
---------Sub Part 1 (2 Sheets are Relevant)
---------Sub Part 2 (2 Sheets are Relevant)
---------Sub Part 3 (2 Sheets are Relevant)
---------Sub Part 4 (2 Sheets are Relevant)
---------Sub Part 5 (2 Sheets are Relevant)
Then, this is linked to an addition I had to make based on the fact that 3 new Sheets were added:
2nd Master
---------Sub Part 1 (2 Sheets are Relevant)
---------Sub Part 2 (2 Sheets are Relevant)
---------Sub Part 3 (2 Sheets are Relevant)
---------Sub Part 4 (2 Sheets are Relevant)
---------Sub Part 5 (2 Sheets are Relevant)
In total, my entire workbook "Macro" is 22 Pages long (Printed Pages). Not sure if that is something you want to really go through. =P Might need an Admin to approve it or something.
[RESOLVED] recorded macro - execution time very long
Reply With Quote
Resolved", if the query is solved
Originally Posted by shailee
