Is there any way to speed up my macro?

Question

I have a macro that will take each value in a list, place it in a different sheet (which performs its own calculations) and returns certain values (like a summary sheet). I have created a looping macro to do this very action, but since there are about 6500 entries on the list, the macro executes at a very slow pace. I have turned off screen updating, and calculations have to be automatic, so I was wondering: is there any other way to speed up the macro?

Sub watchlist_updated()

Application.ScreenUpdating = False

Range("A10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Range("B10:Q10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("Analysis").Select
Range("C5:D5").ClearContents
Range("N6").Select
ActiveCell.FormulaR1C1 = "Yes"

Sheets("Selected Data").Select
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets("Watchlist").Select
Range("A10").Select
ActiveSheet.Paste
countermax = Selection.Count

Range("A10").Select
counter = 1
Do Until ActiveCell = ""
    sStatus = Format(counter / countermax, "0.0%") & " Complete"
    Application.StatusBar = sStatus
    Sheets("Analysis").Range("C5") = ActiveCell.Value

Dim array1(16)
Dim myrange As Range

Set myrange = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 16))

array1(0) = Sheets("Analysis").Range("F5").Value
array1(1) = Sheets("Analysis").Range("C20").Value
array1(2) = Sheets("Analysis").Range("J2").Value
array1(3) = Sheets("Analysis").Range("B8").Value
array1(4) = Sheets("Analysis").Range("J13").Value
array1(5) = Sheets("Analysis").Range("R13").Value
array1(6) = Sheets("Analysis").Range("C21").Value
array1(7) = Sheets("Analysis").Range("B11").Value
array1(8) = Sheets("Analysis").Range("V5").Value
array1(9) = Sheets("Analysis").Range("B12").Value
array1(10) = Sheets("Analysis").Range("J6").Value
array1(11) = Sheets("Analysis").Range("B9").Value
array1(12) = Sheets("Analysis").Range("N20").Value
array1(13) = Sheets("Analysis").Range("H23").Value
array1(14) = Sheets("Analysis").Range("F23").Value
array1(15) = Sheets("Analysis").Range("D23").Value

myrange = array1

    ActiveCell.Offset(1, 0).Select

counter = counter + 1
Loop

Application.StatusBar = False
Sheets("Analysis").Select
Range("N6").Select
ActiveCell.FormulaR1C1 = "No"
Sheets("Watchlist").Select
Application.ScreenUpdating = True

Application.StatusBar = False

End Sub

First, check **[this](http://stackoverflow.com/a/10717999/2687063)** — simpLE MAn, Jan 07 '15 at 20:57
Two changes: `1` Eliminate all of the `Select`, `Selection` statements. `2` Where you are moving data, or the results of formulas, and not the actual formulas, read all the data into a VBA array in a single step: eg `V=Range("B5:V23")`, then move the particular cells into the new array `array1(0)=v(1,5)` would place the contents of what was in F5 into array1(0); and so forth. Then read the array back to the worksheet `myrange = array1` In my experience, working with arrays in VBA can afford as much as a ten-fold improvement in speed, vs going back and forth to the worksheet. — Ron Rosenfeld, Jan 07 '15 at 21:30
Thanks for this tip! I didn't think of this way of doing it but it definitely helped to increase the speed of my macro! — clysaght62, Jan 08 '15 at 15:39

chris neilsen · Answer 1 · 2015-01-08T06:36:36.737

The key to speedy VBA loop is to minimise interaction with the workbook inside the loop.

In your case you won't be able to eliminate interaction entirely, but you can reduce it substantially.

Key steps are:

You can use Manual calculation. (see below)
Create Worksheet and Range objects variables to refer to your sheets and ranges
Create Variant Array's to hold your source data, result data and Analysis results
Once you have a reference to your source data, copy it into a Variant Array. do a For loop over the rows of this array (rather than using ActiveCell)
Create a Results array, sized to the source data rows, by 16 columns wide
On each iteration, copy the source data value onto the Analysis sheet (here's where you can't avoid some workbook interaction)
Force a recalculation of the Analysis sheet with wsAnalysis.Calculate
Copy the results to a variant array in one step. I'd copy the range A1:V23. (Copying too many cells in one step is faster than copying many cells one at a time)
Map the required results into your Results array, into the current row
After the loop, copy the result array to the results range in your workbook (again in one step)

Other notes:

Eliminate all the Select, Selection, ActiveSheet, ActiveCell stuff (as others have mentioned)
Declare all your variables
Be explicit of Lower and Upper bounds in your array declarations
Provide an Error Handler, and CleanUp code to turn on Application properties even when the code errors

After all this, performance will depend on the calculation time of your Analysis worksheet. There may be opportunity for improvement there too, if you would care to share its details

Thanks for all of your help! These are great tips and I tried to implement as much as I could. — clysaght62, Jan 08 '15 at 15:39

score 0 · Answer 2 · answered Jan 08 '15 at 01:08

Whilst this won't speed up the entire thing. You can defs save on time by getting rid of the 'select/selection' bits.

For example for that first section replace:

Range("A10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

with:

Range([A10],[A10].End(xlDown)).ClearContents

Note: the use of [] in this case replaces Range(). Not always healthy to use this shortcut but for your purposes it should be fine. You should always try and rewrite a code you recorded with this formatting before anything else, it bypasses the clumsiness of the macro recorder and turns it into neat vba code :)

Thanks for your help! I guess I got into the bad habit of using selection when I was learning "on-the-go" and never got rid of it. I'm going to try to implement more of this type of code going forward. — clysaght62, Jan 08 '15 at 15:41

score 0 · Answer 3 · answered Jan 08 '15 at 04:39

It is not very pretty but it is fast. I am not very good with making Array's faster but this could be an alternative solution.

Sub watchlist_updated()

'***Define your Variables***
Dim wsAnalysis As Excel.Worksheet
Dim wsWatchList As Excel.Worksheet
Dim wsSelectData As Excel.Worksheet
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastRow3 As Long

'***Set the objects***
Set wsAnalysis = Sheets("Analysis")
Set wsWatchList = Sheets("Watchlist")
Set wsSelectData = Sheets("Selected Data")

'***Turn off Background***
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

'***Finding Last Row - Each Sheet***
LastRow1 = wsSelectData.Range("C" & Rows.Count).End(xlUp).Row
LastRow2 = wsAnalysis.Range("A" & Rows.Count).End(xlUp).Row
LastRow3 = wsWatchList.Range("C" & Rows.Count).End(xlUp).Row

'***Handle any Errors***
On Error GoTo ErrorHandler:

With wsWatchList
    .Range(.Cells(10, 1), .Cells(10 + LastRow3, 17)).ClearContents
End With

With wsAnalysis
    .Range("C5:D5").ClearContents
    .Range("N6").FormulaR1C1 = "Yes"
End With

'***New Copy & Paste Method***
wsWatchList.Range(wsWatchList.Cells(10, 1), wsWatchList.Cells(10 + LastRow1, 1)).Value = _
wsSelectData.Range(wsSelectData.Cells(6, 3), wsSelectData.Cells(6 + LastRow1, 3)).Value

wsAnalysis.Range("C5") = LastRow1 - 5

wsWatchList.Range(wsWatchList.Cells(10, 2), wsWatchList.Cells(LastRow1 + 4, 2)).Value = wsAnalysis.Range("F5").Value
wsWatchList.Range(wsWatchList.Cells(10, 3), wsWatchList.Cells(LastRow1 + 4, 3)).Value = wsAnalysis.Range("C20").Value
wsWatchList.Range(wsWatchList.Cells(10, 4), wsWatchList.Cells(LastRow1 + 4, 4)).Value = wsAnalysis.Range("J2").Value
wsWatchList.Range(wsWatchList.Cells(10, 5), wsWatchList.Cells(LastRow1 + 4, 5)).Value = wsAnalysis.Range("B8").Value
wsWatchList.Range(wsWatchList.Cells(10, 6), wsWatchList.Cells(LastRow1 + 4, 6)).Value = wsAnalysis.Range("J13").Value
wsWatchList.Range(wsWatchList.Cells(10, 7), wsWatchList.Cells(LastRow1 + 4, 7)).Value = wsAnalysis.Range("C21").Value
wsWatchList.Range(wsWatchList.Cells(10, 8), wsWatchList.Cells(LastRow1 + 4, 8)).Value = wsAnalysis.Range("B11").Value
wsWatchList.Range(wsWatchList.Cells(10, 9), wsWatchList.Cells(LastRow1 + 4, 9)).Value = wsAnalysis.Range("V5").Value
wsWatchList.Range(wsWatchList.Cells(10, 10), wsWatchList.Cells(LastRow1 + 4, 10)).Value = wsAnalysis.Range("B12").Value
wsWatchList.Range(wsWatchList.Cells(10, 11), wsWatchList.Cells(LastRow1 + 4, 11)).Value = wsAnalysis.Range("J6").Value
wsWatchList.Range(wsWatchList.Cells(10, 12), wsWatchList.Cells(LastRow1 + 4, 12)).Value = wsAnalysis.Range("B9").Value
wsWatchList.Range(wsWatchList.Cells(10, 13), wsWatchList.Cells(LastRow1 + 4, 13)).Value = wsAnalysis.Range("N20").Value
wsWatchList.Range(wsWatchList.Cells(10, 14), wsWatchList.Cells(LastRow1 + 4, 14)).Value = wsAnalysis.Range("H23").Value
wsWatchList.Range(wsWatchList.Cells(10, 15), wsWatchList.Cells(LastRow1 + 4, 15)).Value = wsAnalysis.Range("F23").Value
wsWatchList.Range(wsWatchList.Cells(10, 16), wsWatchList.Cells(LastRow1 + 4, 16)).Value = wsAnalysis.Range("D23").Value


wsAnalysis.Range("N6").FormulaR1C1 = "No"

wsWatchList.Select

'***Clean Up***
BeforeExit:

Set wsAnalysis = Nothing
Set wsWatchList = Nothing
Set wsSelectData = Nothing

'***Turn on Background***
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Exit Sub
'***Add in a simple ErrorHandler***
ErrorHandler:

MsgBox "Error"

GoTo BeforeExit

End Sub

Hope this helps!

Thanks for doing that! I tried to implement as much as possible using everyone's comments, but it helped exponentially to see the code as you typed it. — clysaght62, Jan 08 '15 at 15:40

Is there any way to speed up my macro?

3 Answers3