VBA Too Slow

[ChrisFoster]

Morning all,

I have some VBA code that on the face of it isn't too resource heavy, but it takes a lot longer to run than I'd expect.

There are circa 11,000 rows of data though so maybe I'm just being naive with my expectations.

Is there anything I can do to speed this up?

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+u
'

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

Sheets("1.Filter-group-1").UsedRange.Copy
Sheets("pfs-Summary.csv").Select
ActiveSheet.Paste
    
    Sheets("1.Filter-group-1").Select
    
    Range("B:D").Delete
    Cells.EntireColumn.AutoFit
    
        Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    Range("A1").Select

    
        Columns("B:CW").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
    End With
    
    
    Cells.Replace What:="Original ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    
Cells.Columns.AutoFit

    Cells.Replace What:="-", Replacement:="0", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

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

End Sub

 

[Cubist]

There are a lot of unnecessary selecting and activating. Try this on a copy.

Sub Macro1()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim sourceRange As Range
    Dim destRange As Range

    Set wsSource = Sheets("1.Filter-group-1")
    Set wsDest = Sheets("pfs-Summary.csv")

    Set sourceRange = wsSource.UsedRange
    Set destRange = wsDest.Range("A1").Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)

    destRange.Value = sourceRange.Value
   
    With wsSource
        .Range("B:D").Delete
        .Cells.EntireColumn.AutoFit

        With .Cells
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With

        .Columns("B:CW").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

        .Cells.Replace What:="Original ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

        .Cells.Columns.AutoFit

        .Cells.Replace What:="-", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    End With

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