CODEWITHSUNDEEP
excelvba
dwirony
dwirony

Reputation: 5450

Excel VBA code running extremely slow even with events turned off

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

Upvotes: 1

Views: 903

Answers (1)

Bill Roberts
Bill Roberts

Reputation: 1171

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

Upvotes: 1

Related Questions