Excel VBA code running extremely slow even with events turned off

Question

The following is a macro that some of my coworkers had already been using to clean up an excel document. It was a complete mess! Believe it or not, this si the cleaned up version (I removed a ton of activewindow scrolling, adjusting column and row widths over and over again). Even after all my cleaning up (and turning off events), this code still runs slow (10-15 seconds) and scrolls all over the page. Any ideas as to how I revamp this to run it a little faster?

Sub MyMacro()
Application.DisplayAlerts = False
    Sheets("P H T Funnel Summary_1").Select
    ActiveWindow.SelectedSheets.Delete
    Rows("1:21").Select
         Selection.ClearContents
         Selection.Delete Shift:=xlUp
'Joyce's Macro
    Rows("1:1").RowHeight = 51
    Rows("1:1").RowHeight = 44.25
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("F:F").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Selection.ColumnWidth = 14.29
   Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("G:G").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Quote Account Name"
    Range("D1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Range("D1:D534").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("AB:AB").Select
    Selection.Cut
    Columns("E:E").Select
    ActiveSheet.Paste
    Columns("K:K").Select
    Selection.Cut
    Columns("G:G").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("H1").Select
    Columns("L:L").Select
    Selection.Cut
    Columns("H:H").Select
    ActiveSheet.Paste
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").Select
    Selection.Cut
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Selection.ColumnWidth = 12.29
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AN:AN").Select
    Selection.Cut
    Columns("J:J").Select
    ActiveSheet.Paste
    Selection.ColumnWidth = 16
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AI:AI").Select
    Selection.Cut
    Columns("K:K").Select
    ActiveSheet.Paste
    Range("K1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("L1").Select
    ActiveCell.FormulaR1C1 = " "
    Columns("AJ:AJ").Select
    Selection.Cut
    Columns("L:L").Select
    ActiveSheet.Paste
    Columns("M:M").Select
    Selection.Cut
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("N1").Select
    Selection.ClearContents
    Columns("X:X").Select
    Selection.Cut
    Range("N1").Select
    ActiveSheet.Paste
    Range("O1").Select
    Columns("N:N").EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("N1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("O1").Select
    ActiveCell.FormulaR1C1 = " "
    Columns("U:U").Select
    Selection.Cut
    Columns("O:O").Select
    ActiveSheet.Paste
    Columns("Y:Y").Select
    Selection.Cut
    Columns("O:O").Select
    Selection.Insert Shift:=xlToRight
    Range("O1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("P1").Select
    Columns("X:X").Select
    Selection.Cut
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight
    Range("Q1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("T:T").Select
    Selection.Cut
    Columns("R:R").Select
    Columns("T:T").Select
    Application.CutCopyMode = False
    Selection.Cut
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
       .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AN:AN").Select
    Selection.Cut
    Columns("T:T").Select
    ActiveSheet.Paste
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 7
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 7.5
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 7
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A1").Select
    Range("D1").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("D1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("C:C").ColumnWidth = 47.14
    Columns("F:F").ColumnWidth = 13.43
    Columns("H:H").ColumnWidth = 18.57
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").ColumnWidth = 14.14
    Columns("K:K").ColumnWidth = 12.14
    Columns("K:K").ColumnWidth = 11
    Columns("M:M").ColumnWidth = 20.43
    Columns("N:N").ColumnWidth = 12.29
    Columns("N:N").ColumnWidth = 12.71
    Columns("O:O").ColumnWidth = 12.43
    Columns("R:R").ColumnWidth = 13.57
    Columns("S:S").ColumnWidth = 24.57
    Columns("T:T").ColumnWidth = 28.57
    Columns("A:A").ColumnWidth = 35
    Columns("U:AU").Select
    Selection.Delete Shift:=xlToLeft
'End of Joyce's Macro
Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:19").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=SEARCH(""CTC"",$S2)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$I2>=10000"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$N2>=30"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(D2>=TODAY()-7,D2<=TODAY())"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=30"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249946592608417
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("A2").Select
    Cells.FormatConditions.Delete
    Range("A2:A5000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=SEARCH(""CTC"",$S2)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B2:B5000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$I2>=10000"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("C2:C5000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$N2>=30"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("I2:I5000").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=0"
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(COUNTBLANK($I2)=0,$I2=0)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("D2:D5000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(D2<=TODAY()+7,D2>=TODAY())"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("M2:M5000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=M2<=TODAY()-30"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249946592608417
    End With
    Selection.FormatConditions(1).StopIfTrue = False
Application.DisplayAlerts = True
End Sub

It is all the Selects and Activates that are put there by the macro recorder. You need to change how vba is refering to the cells by referring directly to the cells and not use Select or Activate. See here: http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — Scott Craner, Mar 15 '17 at 18:20

Bill Roberts · Accepted Answer · 2017-03-15T18:30:54.403

Well, you turned off events... This block for me is fairly standard before macro code does anything:

Dim PrevCalc As XlCalculation
With Application
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
    .Cursor = xlWait
    .Calculate
    .EnableEvents = False
    .ScreenUpdating = False
End With

Then I "undo" when the macro is finished, or in case of error:

With Application
    .Cursor = xlDefault
    .Calculate
    .Calculation = PrevCalc
    '.ScreenUpdating = True 'Not Needed...
    .EnableEvents = True
End With

By the way, every operation you call that modifies cells, is technically a COM call - so you'll want to minimize them. The macro record isn't smart enough to know when modifying a cell that you are only doing one thing.

So for example here where you really only want to center the text:

Range("A1").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlTop
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

Change it to:

Range("A1").HorizontalAlignment = xlCenter

Whoa! Adding those 2 first bits of code is what I was missing! I also cleaned up a lot of the "select" lines, and now it's running in <2 seconds! Perfect, thank you! — dwirony, Mar 15 '17 at 19:24

Excel VBA code running extremely slow even with events turned off

1 Answers1