Slow running macro-CodePudding

I've created a macro (using lots of online help) to take data from one sheet, create another sheet, format the data and set up the printer. Everything works as it should but the macro seems to take a long time to run. Would someone be able to look at my code and see if I've done something that I shouldn't?

Thanks

Sub Preactor_Sort()
    Application.ScreenUpdating = False
'**Copy "Full List" Data into New Sheet**
    Sheets("FULL LIST").Select
    Range("A8:R8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add(Before:=Sheets("MASTER")).Name = "Sorted Full"
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.Zoom = 60
'**************************************************
'**Formatting and removing previous conditional formatting**
    Cells.FormatConditions.Delete
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Bold = False
        .Color = vbBlack
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        .WrapText = True
        .Interior.ColorIndex = 0
        .RowHeight = 23
    End With
    Cells.EntireColumn.AutoFit
'***************************************************
'**Deleting Unwanted Columns**
    Columns("E:E").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("A:C").Select
    Range("A1").Activate
    Selection.Delete Shift:=xlToLeft
'***************************************************
'**Rearranging Columns**
    Columns("G:H").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("K:L").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
'****************************************************
'**Sorting Day/Date**
    Columns("C:C").Select
    Selection.NumberFormat = "dd/mm/yy hh:mm"
    Columns("C:C").EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("C:C").Select
    Selection.NumberFormat = "General"
    '**Find Last Row**
    LR = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    '**Insert Formula**
    Range("C2").Formula = "=TEXT(D2,""ddd"")"
    '**Drag Formula down to last row**
    Range("C2").AutoFill Range("C2:C" & LR)
    Columns("C:C").EntireColumn.AutoFit
'*****************************************************
'**Sorting**
    With ActiveSheet.Sort
        .SortFields.Add2 Key:=Range("C1"), Order:=xlAscending, CustomOrder:="Mon,Tue,Wed,Thu,Fri,Sat,Sun", DataOption:=xlSortNormal
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Make,Discharge,Packing,Wrapping", DataOption:=xlSortNormal
        .SetRange Range("A:P")
        .Header = xlYes
        .Apply
    End With
'******************************************************
'**Formatting**
    Range("C:C,E:E").Select
    With Selection
        .Font.Bold = True
    End With
    Columns("B:B").Select
    Selection.ColumnWidth = 10
    Columns("F:G").Select
    Selection.ColumnWidth = 25
    Columns("A:A").Select
    Selection.ColumnWidth = 8
    Columns("I:J").Select
    Selection.ColumnWidth = 5
    Columns("L:N").Select
    Selection.ColumnWidth = 15
    Columns("O:O").Select
    Selection.ColumnWidth = 80
    Columns("H:H").Select
    Selection.ColumnWidth = 40
    Columns("K:K").Select
    Selection.ColumnWidth = 6
'**Conditional Formatting**
'** Alternating Rows
    Dim lastRow As Long
    lastRow = Range("A1:P1").End(xlDown).Row
    For Each cell In Range("A1:P" & lastRow)
        If cell.Row Mod 2 = 1 Then
            cell.Interior.ColorIndex = 34 'Light Blue
        End If
    Next cell
'**Highlighting Operations
    Dim cell1 As Range
    For Each cell1 In Range("B:B")
        If cell1.Value = "Make" Then
        cell1.Interior.ColorIndex = 35 'Light Green
        ElseIf cell1.Value = "Discharge" Then
        cell1.Interior.ColorIndex = 36 'Light Yellow
        ElseIf cell1.Value = "Packing" Then
        cell1.Interior.ColorIndex = 19 'Light Cream
        ElseIf cell1.Value = "Wrapping" Then
        cell1.Interior.ColorIndex = 6 'Yellow
        ElseIf cell1.Value = "Boxing" Then
        cell1.Interior.ColorIndex = 44 'Light Orange
        ElseIf cell1.Value = "Oil Phase" Then
        cell1.Interior.ColorIndex = 38 'Pink
        End If
    Next
'**Highlighting Day
    Dim cell2 As Range
    For Each cell2 In Range("C:C")
        If cell2.Value = "Mon" Then
        cell2.Interior.ColorIndex = 7 'Pink
        ElseIf cell2.Value = "Tue" Then
        cell2.Interior.ColorIndex = 4 'Green
        ElseIf cell2.Value = "Wed" Then
        cell2.Interior.ColorIndex = 6 'Yellow
        ElseIf cell2.Value = "Thu" Then
        cell2.Interior.ColorIndex = 45 'Orange
        ElseIf cell2.Value = "Fri" Then
        cell2.Interior.ColorIndex = 33 'Blue
        End If
    Next
'** Top Bar Colour
    Range("A1:P1").Select
    With Selection
        .Interior.ColorIndex = 15
        .Font.Bold = True
    End With
'*********************************************************
'** Printer Setup
    Application.PrintCommunication = True
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.12)
        .RightMargin = Application.InchesToPoints(0.12)
        .TopMargin = Application.InchesToPoints(0.16)
        .BottomMargin = Application.InchesToPoints(0.16)
        .HeaderMargin = Application.InchesToPoints(0.12)
        .FooterMargin = Application.InchesToPoints(0.12)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
   ' Application.PrintCommunication = False
End Sub

CodePudding user response：

Trying adding in this, it speeds up by turning off screen updating, events, animations etc, this should speed it up a bit!

At the start of your code add in this sub

Call TurnOffCode

At the end of your code add in this sub

Call TurnOnCode

This is what they should both look like

Sub TurnOffCode() 'Used to turn off settings to make workbook run faster
Application.Calculation = xlCalculationManual 'Set calculations to manual
Application.ScreenUpdating = False 'Turns off screen updating
Application.EnableEvents = False 'Turns off events
Application.EnableAnimations = False 'Turns off animations
Application.DisplayStatusBar = False 'Turns off display status bar
Application.PrintCommunication = False 'Turns off print communications
End Sub

Sub TurnOnCode() 'Used to turn settings back on to normal
Application.Calculation = xlCalculationAutomatic 'Set calculations to automatic
Application.ScreenUpdating = True 'Turns on screen updating
Application.EnableEvents = True 'Turns on events
Application.EnableAnimations = True 'Turns on animations
Application.DisplayStatusBar = True 'Turns on display status bar
Application.PrintCommunication = True 'Turns on print communications
End Sub

However, you should also avoid using selects as well, look at the comment section for a page displaying that information

CodePudding user response：

Thanks for looking at this for me.

I tried the solution that EuanM28 offered and this did marginally increase the speed - from 38sec to around 34sec.

I made a couple of tweaks to my code from

Dim cell1 As Range
For Each cell1 In Range("B:B")

Dim cell1 As Range
For Each cell1 In Range("B2:B" & LR) '*LR = last row variable defined earlier in the code

and

Dim cell2 As Range
For Each cell2 In Range("C:C")

Dim cell2 As Range
For Each cell2 In Range("C2:C" & LR)

This made a huge difference (34sec to 6sec) I'm guessing because it's no longer cycling through all the rows on the sheet and just the populated ones.

I will have to look into removing .Selects as suggested (didn't realise it causes so many issues!)

Thanks