View Full Version : Macro becoming slower
Valentino142
05-30-2014, 03:39 PM
Hi,
For some time I've been working on a project, which loops certain calculations for each day in a multi year period. Running the macro typically takes around 24 hours, which is quite a while but acceptable given the calculations required. It's been optimised with the help of a former colleague, which happened to be a real crack in VBA, and it contains screenupdating = false and manual calculation instead of continuous. Lately however, the macro is slowing down and now even takes multiple days to complete....and this colleague now moved to another firm :(
I'm wondering if you could give any tips regarding general performance of VBA. If required, i would be happy to post the code or even send you the workbook but don't consider much to be gained here as it's already optimised and the current code used to run fine as it is (ie 24 hrs, under the same Excel version(2013, 64bit) and Windows 7). I've checked Task Manager to see the memory usage, and it consumes all memory available (6GB). Also, I've tried to restart the computer, and even cleaned redundant data, defragmented etc. The file is not that big (<4mb).
Can you give any hints what to do to improve performance of a macro? Or how can i find out which part of the macro is performing slowly so i can find a work around for that? If you requie any more info please let me know. Help is much appreciated!!
Thanks in advance,
Valentino
ashleyuk1984
05-31-2014, 12:10 AM
I remember reading somewhere else that a macro that took quite some time to run was getting slower (like you describe), and I seem to remember that one of the answers was for him to defrag the computer, and this apparently worked... From what I can see you have already done this. So this obviously hasn't worked for you.
I also see that you've also changed the screenupdating property to false and changed it to manual calculation - both of these would usually cause your code to run much faster - so good job on that.
I'm sure there was something else that could be changed too but I can't remember what it was - I'm sure it was something similar to manual calculation. If I remember it I'll post it.
Apart from that, maybe upload your workbook with the code and perhaps we can make some improvements to the code itself
Valentino142
05-31-2014, 02:25 AM
Ashley,
Perhaps you refer to DisableEvents, tried that but it didn't speed up so I left it out.
As said, the macro was coded by someone with alot of experience in VBA, so I expect the most common mistakes that slow down macro performance are already mitigated. Also, the code worked fine before, which was why i was looking for some explanation beyond the code itself. The workbook, saved as an .xlsb, is around 3mb's so not massive. If required, i will post the workbook itself so you can have a look. Nevertheless, here's the code, it's a bit of a beast but if you have suggestions to speed up i'm curious to hear about it.
Sub RunPeriod()
If MsgBox("Week/Day is Day?", vbOKCancel) = vbCancel Then Exit Sub
If MsgBox("Current date is Start test (2-aug-10)?", vbOKCancel) = vbCancel Then Exit Sub
Application.ScreenUpdating = False
ResetTable
Dim i As Date
i = Range("StartTest")
Do While i < Range("LastMarket") + 1
If Weekday(i, vbSaturday) > 2 Then
Range("b2").Value = i
RunToday
Debug.Print i
End If
i = i + 1
Loop
Application.ScreenUpdating = True
ThisWorkbook.SaveAs "C:\Users\Barry van Oven\Documents\Investing " & Format(Now, "YYYY-MM-DD-HH-NN") & ".xlsb"
End Sub
Sub ResetTable()
'
' ResetTable Macro
'
Range("B1").Select
Sheets("Table").Select
Range("T11").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "0"
Range("T11").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("BE11").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "0"
Range("BE11").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("B9").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("topsheet").Select
Range("A1").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=6
Sheets("PF period").Select
Rows("10:10").Select
Range(Selection, Selection.End(xlDown)).ClearContents
Range("A1").Select
Sheets("Table").Select
Range("B9").Select
End Sub
Sub RunToday()
'
' RunToday Macro
'
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Reset
Refresh
Copytransactions
Copydiagnostics
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Reset()
'
' Reset Macro
Sheets("Prev").Range("A1:BZ300").Value = Sheets("Table").Range("B9:CA309").Value
Sheets("Table").Range("B9:CA309").Copy
Sheets("Prev").Range("A1:BZ300").PasteSpecial (xlPasteFormats)
Sheets("Graph").Select
Range("AT1").Select
Sheets("Table").Select
Range(Range("B10"), Range("B10").End(xlToRight)).AutoFill Destination:=Range("B10:Bg93")
Calculate
Range("A11").Select
End Sub
Sub Refresh()
'
' Refresh Macro
For i = 1 To 83
Sheets("Graph").Range("AT1").Value = Sheets("Table").Cells(i + 10, 1).Value
Calculate
Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value = Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value
Next i
Range("B9").Select
End Sub
Sub Copytransactions()
'
' Copytransactions Macro
'
Sheets("Closed").Select
Sheets("Closed").Rows("1:86").Insert Shift:=xlDown
Sheets("Transclose").Select
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
Calculate
Range("A1:A86").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Closed").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Transclose").Select
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
Range("A1:A86").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Closed").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("87:87").Delete Shift:=xlUp
Range("A1:A2500").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Calculate
Sheets("Running").Select
Selection.AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
Sheets("Table").Select
Range("B9").Select
Sheets("PF period").Select
Rows("10:10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("10:10").Value = Rows("2:2").Value
Range("A1").Select
Sheets("Table").Select
Range("B9").Select
Calculate
End Sub
Sub Copydiagnostics()
' Copydiagnostics Macro
'
Sheets("Diagnostics").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Table").Range(Range("BP2"), Range("BP2").End(xlToRight)).Copy
Sheets("Diagnostics").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Table").Range(Range("BP2"), Range("BP2").End(xlToRight)).Copy
Sheets("Diagnostics").Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:1427").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Diagnostics").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Diagnostics").Sort.SortFields.Add Key:=Range("A1") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Diagnostics").Sort
.SetRange Range("A1:ap377")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Sheets("Table").Select
Range("C10").Select
Sheets("topsheet").Select
Sheets("topsheet").Range("A85:ac500").FormulaR1C1 = "=Diagnostics!R[-84]C"
Calculate
Range("bb30:bb4720").FormulaR1C1 = "=Closed!R[-29]C[-53]"
Calculate
Range("A1").Select
If Range("H4") <> 1 Then
Exit Sub
End If
End Sub
ashleyuk1984
05-31-2014, 04:14 AM
Yes, I think it was DisableEvents. That certainly rings a bell.
If I'm honest the code looks rather small from first glance. I'm actually surprised it takes 24 hours - or more to run.
By just glancing at the code I can see a lot of ".Select" commands - which technically isn't necessary.
It's an easy habbit to get into - especially for someone that might be new to VBA programming - or using the Macro recorder.
You can usually replace these .select commands along with the next couple of lines (normally something like copy or paste) down to one complete line of code.
Anyway, it will be helpful if we also had the workbook please.
I'll go through the code step by step and see why it's taking so long to run.
Seeing the workbook might make more sense as to why :)
Thanks
Valentino142
05-31-2014, 09:57 AM
Ashley,
Thanks for the suggestion, the Select commands must be legacy of me recording the origins of the macro. My ex-colleague already trimmed the code far from what it used to be...
In fact, you would probably not believe it when I say that the macro currently takes 3 full days to complete...especially knowing that i have an i7 processor with SSD drive to run it :banghead:
If you could have a look at improving the code to make it run more efficient, I'm very open to any improvements and learning how to make things better. Particularly interested in your approach to go through step by step to see where it slows down. If there's some sheet that absorbs a lot of calculation capacity please let me know, I will have a look to see if I can clean that up. Still, i'm puzzled how this macro keeps getting slower lately without modifying it....
Anyway, your help is very much appreciated, mate!!!
Bob Phillips
05-31-2014, 10:46 AM
See if this is any better
Sub RunPeriod()
Dim i As Date
If MsgBox("Week/Day is Day?", vbOKCancel) = vbCancel Then Exit Sub
If MsgBox("Current date is Start test (2-aug-10)?", vbOKCancel) = vbCancel Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ResetTable
i = Range("StartTest").Value
Do While i < Range("LastMarket").Value + 1
If Weekday(i, vbSaturday) > 2 Then
Range("b2").Value = i
RunToday
Debug.Print i
End If
i = i + 1
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.CutCopyMode = False
ThisWorkbook.SaveAs "C:\Users\Barry van Oven\Documents\Investing " & Format(Now, "YYYY-MM-DD-HH-NN") & ".xlsb"
End Sub
Sub ResetTable()
Dim lastrow As Long
With Worksheets("Table")
.Range(.Range("T11"), .Range("T11").End(xlDown)).Value = "0"
.Range(.Range("BE11"), .Range("BE11").End(xlDown)).Value "0"
End With
With Worksheets("PF period")
.Range(.Rows("10:10"), .Rows("10:10").End(xlDown)).ClearContents
End With
End Sub
Sub RunToday()
Application.EnableEvents = False
Reset
Refresh
Copytransactions
Copydiagnostics
Application.EnableEvents = True
End Sub
Sub Reset()
With Worksheets("Table")
Worksheets("Prev").Range("A1:BZ300").Value = .Range("B9:CA309").Value
.Range("B9:CA309").Copy
Worksheets("Prev").Range("A1:BZ300").PasteSpecial Paste:=xlPasteFormats
.Range(.Range("B10"), .Range("B10").End(xlToRight)).AutoFill Destination:=.Range("B10:BG93")
.Calculate
End With
End Sub
Sub Refresh()
Dim i As Long
With Worksheets("Table")
For i = 1 To 83
Worksheets("Graph").Range("AT1").Value = .Cells(i + 10, 1).Value
.Calculate
.Range(.Cells(i + 10, 1), .Cells(i + 10, 70)).Value = .Range(.Cells(i + 10, 1), .Cells(i + 10, 70)).Value
Next i
End With
End Sub
Sub Copytransactions()
Worksheets("Closed").Rows("1:86").Insert Shift:=xlDown
With Worksheets("Transclose")
.Range("A1").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
.Range(.Range("A1:A86"), .Range("A1:A86").End(xlToRight)).Copy
Worksheets("Closed").Range("A1").PasteSpecial Paste:=xlPasteValues
Worksheets("Closed").Range("A1").PasteSpecial Paste:=xlPasteFormats
.Rows("87:87").Delete Shift:=xlUp
With .Range(.Range("A1:A2500"), .Range("A1:A2500").End(xlToRight))
.Sort Key1:=Range("A1"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
.Calculate
End With
Worksheets("Running").AutoFilter Field:=1, Criteria1:="<>0", Operator:=xlAnd
With Worksheets("PF period")
.Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("10:10").Value = Rows("2:2").Value
End With
End Sub
Sub Copydiagnostics()
With Worksheets("Diagnostics")
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
With Worksheets("Table")
.Range(.Range("BP2"), .Range("BP2").End(xlToRight)).Copy
Worksheets("Diagnostics").Range("A1").PasteSpecial Paste:=xlPasteValues
Worksheets("Diagnostics").Range("A1").PasteSpecial Paste:=xlPasteFormats
End With
With ActiveWorkbook.Worksheets("Diagnostics")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:ap377")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
With Sheets("topsheet")
.Range("A85:AC500").FormulaR1C1 = "=Diagnostics!R[-84]C"
.Range("BB30:BB4720").FormulaR1C1 = "=Closed!R[-29]C[-53]"
.Calculate
End With
End Sub
Valentino142
05-31-2014, 12:22 PM
Thanks Grand Master, looks very fast indeed, impressive. Yet I've tested and it throws out an error:
Runtime error '438': Object doesn't support this property or method
at .Range(.Range("BE11"), .Range("BE11").End(xlDown)).Value "0"
Is this something that can be fixed?
Thanks again!
Aussiebear
05-31-2014, 01:37 PM
That should be = 0 at the end of the line
Paul_Hossler
05-31-2014, 01:58 PM
If the macro and the computer are basically the same, then I'd think 'data'
If the WB has been used and edited many times, then I'd create a new empty workbook, and copy/paste the data from the old to the new, and copy paste the macro code into new modules
ashleyuk1984
05-31-2014, 02:02 PM
Valentino142,
Thanks for the workbook via PM. I ran the macro that was saved in the workbook. The same one that you posted above.
The macro finished in about 15 - 20 minutes.
From what I can see, it ran from 01/01/2010 to 26/02/2010 (I presume this is the same code that you are running) ??
Can you confirm that this is the same code and dates that you are running the code for - but is taking 3 days to run?
Valentino142
05-31-2014, 02:54 PM
Ashley, indeed this is the same code, and in this sample period it takes for me about 1 hr. If i set the finish date till 28/12/12 it's taking me 3 days.... Any improvements that you might suggest to the code or other settings...?
Paul, maybe you're right and I need to copy into a fresh WB. I was presuming that the WB was not getting filled with invisible data since the file is not growing in size, but maybe there is some mist developping in the old file (which is running for some months now). I'll give it a try after the weekend and keep you posted.
Grandmaster, I'm trying to run the code but got aother runtime error - i'll try again later and report.
Thnks a lot guys for all your smart thinking!!
ashleyuk1984
05-31-2014, 04:00 PM
I see, that will explain why it takes much longer then.
It's midnight for me here now, so I'll take a look tomorrow if I have a chance.
It might be worth posting up your workbook for others to download and contribute.
Paul_Hossler
06-02-2014, 06:16 AM
No details about the actual application, but since date is part of the inputs, are you re-computing past data that could be stored and re-used without having to be recomputed?
Bob Phillips
06-02-2014, 11:00 AM
Why not post the workbook here so that we can all see it?
Valentino142
06-02-2014, 11:09 PM
Why not post the workbook here so that we can all see it?
Tried to upload the file, but it returns that upload is failed... here's a link to the file, let me know when you have trouble downloading it
Thanks!
https://www.dropbox.com/s/k3vk2v9c4dk62kj/Slow.xlsb?n=9356131
Skim read the first code posted. I've no idea how much difference it would make but is there a reason behind the for loop in Refresh()?
For i = 1 To 83
Sheets("Graph").Range("AT1").Value = Sheets("Table").Cells(i + 10, 1).Value
Calculate
Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value = _
Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value
Next i
Unless I'm missing something it seems to be the same as
Sheets("Graph").Range("AT1").Value = Sheets("Table").Cells(93, 1).Value
Calculate
Range("B9").Select
Valentino142
06-04-2014, 12:07 PM
Paul,
Indeed some of the past data is re-computed, and even though this probably slows down calculations it provides no explanation how this macro becomes slower and slower, since even the fastest version was recalculating past data.... BTW, I'm currently running a rebuilt version as per your suggestion, but from first sight it appears equally slow. Any other suggestions?
Thanks!
Valentino142
06-04-2014, 12:10 PM
Skim read the first code posted. I've no idea how much difference it would make but is there a reason behind the for loop in Refresh()?
For i = 1 To 83
Sheets("Graph").Range("AT1").Value = Sheets("Table").Cells(i + 10, 1).Value
Calculate
Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value = _
Sheets("Table").Range(Cells(i + 10, 1), Cells(i + 10, 70)).Value
Next i
Unless I'm missing something it seems to be the same as
Sheets("Graph").Range("AT1").Value = Sheets("Table").Cells(93, 1).Value
Calculate
Range("B9").Select
I don't think this would work, as it recalculates for each of the 83 underlying variables....
Again, I'm curious to understand how this macro becomes slower than earlier versions, which included the same code....
Valentino142
06-09-2014, 06:44 AM
Here's a small update from what i've tried.
I'm having some success with Paul's suggestion to rebuild the workbook, initially it was much quicker but on the second run it's slowing down by around 15%...hopefully it's not slowing down further as i rerun the book with new data since that would bring me back to where I've started.
Also, I'm looking into John's suggestion to replace the loop with some more concise code, this could be a better solution i guess.
Any other solutions anybody? Any tips from looking at the workbook i've posted?
Many thanks
Valentino
I'm not an Excel expert and don't know what you are doing/how you are running the code, etc.
But in my general experience, slowing down generally means an increase in data. (And 6GB is a lot of data/memory usage!)
Does the file size grow between runs? If you save to a new file how big is that file compared to the master?
Have you made sure reviewing features are turned off?
As far as your previous post. I know it recalculates, but why? It doesn't make sense unless you are doing something with the recalculated values. It's the same cell that is being updated every loop and as far as I could see nothing was using that data.
Valentino142
06-09-2014, 08:01 AM
John,
thanks for your quick reply. The size is not growing in size between runs, also since ithe macro "cleans" at the beginning by deleting some arrays that fill up with invisible data during a run - hence, it is always around 3,5MB (.xlsb). After rebuilding, it actually grew to 4.5MB but that was ok with me as the performance was good.
What do you mean with reviewing features. There's no protection on the workbook or track changes, if that's what you mean...?
Recalculating is a feature which is difficult to drop I'm affraid. The model makes calculations for a certain period and then newer data is added, for which it makes the same calculations for that newer data. Older data is dropped and no calculations are made. Hence, the data "flows" through the model. I will give it a try to think of an alternative solution, not recalculating...
Thanks for thinking along with me, valentino
Paul_Hossler
06-09-2014, 09:05 AM
My experence is that
1) improving the algorithms usually has a big payback, as does
2) 'working with' Excel's object models (for example, deleting worksheet rows bottoms up, etc.)
Valentino142
06-10-2014, 10:56 PM
I'm not an Excel expert and don't know what you are doing/how you are running the code, etc.
But in my general experience, slowing down generally means an increase in data. (And 6GB is a lot of data/memory usage!)
Does the file size grow between runs? If you save to a new file how big is that file compared to the master?
Have you made sure reviewing features are turned off?
As far as your previous post. I know it recalculates, but why? It doesn't make sense unless you are doing something with the recalculated values. It's the same cell that is being updated every loop and as far as I could see nothing was using that data.
Been looking into the alternatives for the "recalculation", as sugested by both John and Paul. I think I could modify the workbook to make the necessary calculations for the most recent day only and "storing" the results after calculation is done. Then I would lookup (probably by using Index formula) the already calculated (and "stored") values for past data, in the place where I now recalculate. Essentially, I replace a lot of complex calculations in the main worksheet by a lookup function (hence keeping most of the sheet unchanged). From a general perspective, do you think this lookup instead of calculations could bring the desired performance increase..? It would require a bit of work, so happy to get some guidance from you guys before I start.... Is this the "imrovement of algorithms (with a big payback" mentionned by Paul?
Thanks
Looking back to posts #10 and #11 it seems that it took ashleyuk1984 ~20 mins to run the same code on the same data that took you an hour.
(I'd try running it myself but your link doesn't work for me.)
Some or all of that time difference could be down to hardware (you'd need to compare specs). Or it could be something else.
If you don't have another pc to test on I'd start by uninstalling and reinstalling Excel and checking for other system hogging processes. Disabling your printer (if you have one) might even be worth a go.
Optimising your code is a good idea, but if there is another underlying problem you might get better results if you fix that first.
Valentino142
06-11-2014, 07:45 AM
Looking back to posts #10 and #11 it seems that it took ashleyuk1984 ~20 mins to run the same code on the same data that took you an hour.
(I'd try running it myself but your link doesn't work for me.)
Some or all of that time difference could be down to hardware (you'd need to compare specs). Or it could be something else.
If you don't have another pc to test on I'd start by uninstalling and reinstalling Excel and checking for other system hogging processes. Disabling your printer (if you have one) might even be worth a go.
Optimising your code is a good idea, but if there is another underlying problem you might get better results if you fix that first.
Actually I found a nice page to benchmark Excel performance, please see
http://exceltrader.net/984/benchmark_et-xls-an-excel-benchmark-for-traders/
My score was 66, with an I7 3.07 Ghz processor with 6GB on Windows 7/Excel 2013. Not that good, but not to explain a huge underperformance either.
I don’t have any printer or add-ins, which are renowned for slowdown allso.
thanks
The main problem is
- the abundant unnecessary use of Activate & Select
- the abundant & unnecessary use of 'scroll'
- the abundant and unnecessary writing/reading operations into the worksheets
- the lack of use of calculations in memory (in arrays)
- if you think your former colleague was a crack in VBA we disagree.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.