The below code does what i want but takes maybe 10 minutes to run, is there anything anyone can see to speed this code up?



Dim CName As String
Dim DT As Date
Dim FName As String
Dim DTStr As String
Dim WS As Worksheet
Dim CLLR As Long
Dim DataLR As Long
Dim Counter As Long
Dim PStatLR As Long
Dim QueLR As Long


CName = Sheets("Report").Range("C7")
DT = Date
TName = Replace(DT, "/", "")
FName = CName & " " & TName

Application.Calculation = xlAutomatic

    ActiveWorkbook.SaveAs Filename:= _
        "https://**********.sharepoint.com/sites/Build/Shared%20Documents/General/Run%20Rate%20Trackers/" & FName & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "APX Data" And WS.Name <> "APX Query" And WS.Name <> "Project Status" And WS.Name <> "Contractor List" And WS.Name <> "Bank Holidays" And WS.Name <> CName Then
WS.Delete
End If
Next WS

 If Sheets("APX Data").AutoFilterMode Then
     Sheets("APX Data").AutoFilterMode = False
  End If
'40k rows of data


If Sheets("Contractor List").AutoFilterMode Then
     Sheets("Contractor List").AutoFilterMode = False
  End If

'300 rows of data
  
If Sheets("APX Query").AutoFilterMode Then
     Sheets("APX Query").AutoFilterMode = False
  End If

'300 rows of data
  
If Sheets("Project Status").AutoFilterMode Then
     Sheets("Project Status").AutoFilterMode = False
  End If

'100 rows of data

DataLR = Sheets("APX Data").Cells(Rows.Count, 1).End(xlUp).Row
CLLR = Sheets("contractor List").Cells(Rows.Count, 1).End(xlUp).Row
QueLR = Sheets("APX Query").Cells(Rows.Count, 11).End(xlUp).Row
PStatLR = Sheets("Project Status").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Contractor List").Range("$A$1:$F$" & CLLR).AutoFilter Field:=4, Criteria1:="<>" & CName, Operator:=xlFilterValues
Sheets("contractor List").Range("$A$2:$F$" & CLLR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheets("Contractor List").AutoFilterMode = False
        
Sheets("APX Data").Range("$A$1:$AN$" & DataLR).AutoFilter Field:=39, Criteria1:="<>" & CName, Operator:=xlFilterValues
Sheets("APX Data").Range("$A$2:$AN$" & DataLR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheets("APX Data").AutoFilterMode = False
            
Sheets("Project Status").Range("$A$1:$Q$" & PStatLR).AutoFilter Field:=3, Criteria1:="<>" & CName, Operator:=xlFilterValues
Sheets("Project Status").Range("$A$2:$Q$" & PStatLR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sheets("Project Status").AutoFilterMode = False

Sheets("APX Query").Range("$A$6:$J$" & QueLR).Delete SHIFT:=xlToLeft
          
Sheets("APX Query").Range("$A$7:$I$" & QueLR).AutoFilter Field:=1, Criteria1:="<>" & CName, Operator:=xlFilterValues
Sheets("APX Query").Range("$A$8:$I$" & QueLR).SpecialCells(xlCellTypeVisible).Delete
Sheets("APX Query").AutoFilterMode = False

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