How do I speed up my code execution?

Question

I have a routine that works very well. The only problem is that it takes too long to execute. Can you make suggestions on how to speed it up? I think one way is for me to directly attribute values to ranges as opposed to going through selecting the sheet then using the activesheet object.

Sub calculate()

Dim rng1 As Range
Dim lastCell As Range
Dim starFill As Range
'Dim LastCellRowNumber As Long
Dim strFind As String
Dim rng2 As Range
strFind = "***"
Dim clearFormat As Range
Dim demand As Range
Dim demandFill As Range
Dim supply As Range
Dim supplyFill As Range
Dim delta As Range
Dim deltaFill As Range
Dim i As Integer
Dim j As Integer
Dim rng3 As Range
Dim rng4 As Range
Dim lasteCell2 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim mon As Range
Dim k As Integer



'save month values from resource plan for use in dashboard
Worksheets("Resource Plan").Columns("D:D").EntireColumn.Hidden = False
For j = 1 To 6
Worksheets("Resource Plan").Select
Set mon = ActiveSheet.Cells(2, (j + 9))

For k = 1 To 29
Select Case k
Case 5, 11, 17, 23, 29
Worksheets("Dashboard").Select
Worksheets("Dashboard").Cells(k, (j + 3)).Value = mon
Case Else
End Select
Next k
Next j


'calculate demand
Worksheets("Resource Plan").Select

Set rng4 = ActiveSheet.Columns("D").Find(strFind, , xlValues, xlWhole)
    rng4.Select
    Set lastCell2 = ActiveSheet.Cells(ActiveSheet.Rows.Count, (4)).End(xlUp)
    Set rng5 = Range(rng4, lastCell2)
    Set rng5 = rng5.Offset(0, 0).Resize(rng5.Rows.Count - 1)
For i = 0 To 29
    Worksheets("Resource Plan").Select
    Set rng1 = ActiveSheet.Columns("J").Find(strFind, , xlValues, xlWhole)
    Set lastCell = ActiveSheet.Cells(ActiveSheet.Rows.Count, (10)).End(xlUp)
    Set rng2 = Range(rng1, lastCell)
    Set rng2 = rng2.Offset(4, i).Resize(rng2.Rows.Count - 5, rng2.Columns.Count)
    rng2.Select
    Selection.Copy
    Worksheets("Sheet1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Set rng3 = Sheets("Sheet1").Cells(1, 3)
    rng3.Select
    Selection.Copy
    Worksheets("Results").Select
    Cells(18, (i + 7)).Select
    Selection.PasteSpecial Paste:=xlValues
Next i
Worksheets("Resource Plan").Select
Columns("D:D").EntireColumn.Hidden = True
Cells(1, 1).Select


'Worksheets("Dashboard").Select

End Sub

A good way to speed up your macro is to use `Application.Screenupdating = False` and `Application.Calculation = xlManual` and `Application.EnableEvents = False`. Just be sure to return them to `True` and `xlAutomatic` and `True` before exiting the sub. [see](http://stackoverflow.com/questions/13016249/how-to-improve-the-speed-of-vba-macro-code) — Raystafarian, Mar 18 '16 at 18:21
This really is not the right platform for this. See http://codereview.stackexchange.com/ . Also you want to stop using `.Select` see [HERE](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). Another thing that can be used is to use arrays instead of constantly refer to an excel sheet. — Scott Craner, Mar 18 '16 at 18:24
Sorry, normally I ask more pointed questions. New to the site. — Brad, Mar 18 '16 at 18:26
In addition to @ScottCraner's suggestions (and Raystafarian's), instead of copy/paste, you can just set two ranges' values equal to each other. — BruceWayne, Mar 18 '16 at 19:06

score 2 · Accepted Answer · answered Mar 18 '16 at 19:57

Just to summarize some of the above comments:

Option Explicit

Sub calculate()

Dim rng1 As Range
Dim lastCell As Range
Dim strFind As String
Dim rng2 As Range
strFind = "***"
Dim i As Integer
Dim j As Integer
Dim rng3 As Range
Dim rng4 As Range
Dim lastCell2 As Range
Dim rng5 As Range
Dim k As Integer

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With

With Worksheets("Resource Plan")

    'save month values from resource plan for use in dashboard
    .Columns("D:D").EntireColumn.Hidden = False
    For j = 1 To 6
        For k = 1 To 29
            Select Case k
                Case 5, 11, 17, 23, 29
                    Worksheets("Dashboard").Cells(k, (j + 3)).Value2 = .Cells(2, (j + 9)).Value2
                Case Else
            End Select
        Next k
    Next j

    'calculate demand
    Set rng4 = .Columns("D").Find(strFind, , xlValues, xlWhole)
    Set lastCell2 = .Cells(.Rows.Count, (4)).End(xlUp)
    Set rng5 = .Range(rng4, lastCell2)
    Set rng5 = rng5.Offset(0, 0).Resize(rng5.Rows.Count - 1)
    For i = 0 To 29
        Set rng1 = .Columns("J").Find(strFind, , xlValues, xlWhole)
        Set lastCell = .Cells(.Rows.Count, (10)).End(xlUp)
        Set rng2 = Range(rng1, lastCell)
        Set rng2 = rng2.Offset(4, i).Resize(rng2.Rows.Count - 5, rng2.Columns.Count)
        rng2.Copy Destination:=Worksheets("Sheet1").Range("A1")
        Set rng3 = Sheets("Sheet1").Cells(1, 3)
        Worksheets("Results").Cells(18, (i + 7)).Value2 = rng3.Value2
    Next i
    .Columns("D:D").EntireColumn.Hidden = True
    .Activate
    .Cells(1, 1).Select
End With

'Worksheets("Dashboard").Select

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
End With

End Sub

Unnecessary Dim (because not used in the sub) have been removed.
Disable ScreenUpdating, Calcultion, and Events.
Remove all .Select (except for the last one).
Summarizing several steps.
Using .Value2 instead of .Value

How do I speed up my code execution?

1 Answers1