Is there any way to speed up my macro? - vba

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

Answer 1

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

Answer 2

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 :)

Answer 3

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!