VBA Code Efficiency

J

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
840
Hello, Can I make the following code run quicker? Other than run it on the hard drive rather than the OneDrive?

Many thanks.


Code: 
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]
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
You must log in or register to reply here.

Similar threads

A
  • Solved
How use RC formulas when fill three columns
2
Replies
18
Views
242
MARK858
MARK858
G
  • Solved
Typing out Excel formula in Excel Macro
Replies
1
Views
86
Macropod
Macropod
S
  • Solved
Return error if "Filter" doesn't return the required entry
Replies
2
Views
172
skittlz
S
W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
231
who am i
W
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top