VBA Code Efficiency

[jamescooper]

Hello, Can I make the following code run quicker? Other than run it on the hard drive rather than the OneDrive?

Many thanks.

Sub Clean_Data()


Dim myValue As Variant
Dim myValue2 As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FP As String, FN As String


myValue = InputBox("Enter the railway period, e.g. 1804")
myValue2 = InputBox("Enter the date you wish to clean the data in format yyyy-mm-dd e.g. 2017-06-28")


Workbooks.Open ("C:\Users\jamesco\OneDrive for Business\PMO - Schedule 4 - Sharing best practice\2. CrossCountry Trains\Data\" & myValue & "\Raw\" & myValue2 & ".xlsb")
'Change folder path/file as appropriate


Sheets("Sheet1").Delete


Sheets("Sheet0").Rows("1:5").Delete Shift:=xlUp


Cells.Select
Cells.EntireColumn.AutoFit
Range("J1").ColumnWidth = 10


Application.Calculation = xlAutomatic


Range("J2").FormulaR1C1 = "=IF(MID(RC[-8],3,1)=""5"",1,"""")"
Range("J2").AutoFill Destination:=Range("J2:J" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("J" & .Rows.Count).End(xlUp).Row


With .Range("J1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Range("J2").FormulaR1C1 = "=IF(MID(RC[-8],3,1)=""3"",1,"""")"
Range("J2").AutoFill Destination:=Range("J2:J" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("J" & .Rows.Count).End(xlUp).Row


With .Range("J1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Range("K2").FormulaR1C1 = "=IF(OR(RC[-4]=""NAILSEA B"",RC[-4]=""YATTON"",RC[-4]=""WHITEBALL"",RC[-4]=""MEDOWHALL"",RC[-4]=""NORTNFZWJ"",RC[-4]=""STECHFORD"",RC[-4]=""AISHXOVER"",RC[-4]=""STAPLTNRD""),1,"""")"
Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("K" & .Rows.Count).End(xlUp).Row


With .Range("K1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Range("J2").FormulaR1C1 = "=IF(VALUE(RC[-2])<VALUE(""03:00""),RC[-2]+1,VALUE(RC[-2]))"
Range("J2").AutoFill Destination:=Range("J2:J" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


Range("J1") = "Time Value"


    Columns("J:J").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("I1").Select
    Selection.Copy
    Range("J1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False


Dim LastRow As Long, ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet0")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
 ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range( _
 "B2:B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 ws.Sort.SortFields.Add Key:=Range( _
 "J2:J" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
  ws.Sort.SortFields.Add Key:=Range( _
 "I2:I" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ws.Sort
 .SetRange Range("A1:O" & LastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 
Columns("K:K").ClearContents


Range("K2").FormulaR1C1 = "=IF(AND(R[-1]C[-2]=""T"",RC[-2]=""A""),1,"""")"
Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("K" & .Rows.Count).End(xlUp).Row


With .Range("K1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Columns("K:K").ClearContents


Range("K2").FormulaR1C1 = "=IF(AND(R[-1]C[-2]=""T"",RC[-2]=""A""),1,"""")"
Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("K" & .Rows.Count).End(xlUp).Row


With .Range("K1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Columns("K:K").ClearContents


Range("K2").FormulaR1C1 = "=IF(AND(R[-1]C[-2]=""T"",RC[-2]=""D""),1,"""")"
Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("K" & .Rows.Count).End(xlUp).Row


With .Range("K1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


Columns("K:K").ClearContents


Range("K2").FormulaR1C1 = "=IF(AND(R[-1]C[-2]=""T"",RC[-2]=""D""),1,"""")"
Range("K2").AutoFill Destination:=Range("K2:K" & Sheets("Sheet0").Range("A" & Rows.Count).End(xlUp).Row)


With ActiveSheet
  If .AutoFilterMode Then .AutoFilterMode = False
  r = .Range("K" & .Rows.Count).End(xlUp).Row


With .Range("K1").Resize(r)
    .AutoFilter
    If Application.CountIf(.Cells, 1) > 0 Then
        .AutoFilter Field:=1, Criteria1:=1
        .Offset(1).Resize(r - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  
   End If
   
End With
.AutoFilterMode = False


End With


End With


End With


End With


End With


End With


End With


End With


    Range("N2").FormulaR1C1 = "=VALUE(RC[-13])"
    Range("N2").Select
    Selection.NumberFormat = "yyyy-mm-dd"
    Range("N2").Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
FP = "C:\Users\jamesco\OneDrive for Business\PMO - Schedule 4 - Sharing best practice\2. CrossCountry Trains\Data\" & myValue & "\Cleaned\" & FN
FN = Sheets("Sheet0").Range("N2")
ActiveWorkbook.SaveAs Filename:=FP & Format(FN, "yyyy-mm-dd"), FileFormat:=50
    
ActiveWorkbook.Close


Application.ScreenUpdating = True


MsgBox ("Data Clean Complete")


End Sub

[/HTML][/CODE]