VBA Help speed up and stop not responding

[jameswalker81]

HI All

I am new to VBA and looking online and recording Macros to help build my code. But I am having a issue when I get to part of my code it is slow up and also making excel go into not responding. Is there anything I can do to my code to speed this up when I run it and also stop it going into not responding?

Many Thanks

James

Sub Macro1()
'
' Macro1 Macro
'


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With


' -------------------------------- UPDATEING ROLLING INTAKE TRACKER APL TAB --------------------------------
'


'---------Check for Filters in APL data------




    Sheets("APL file").Select
If ActiveSheet.AutoFilterMode Then 'autofilter is 'on'
   On Error Resume Next   'turn off error reporting
   ActiveSheet.ShowAllData
   On Error GoTo 0   'turn error reporting back on
End If


'---------Delete old APL data------


    'Sheet8.Select
    Range("A2:BJ2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select




'-------Open new APL file--------


    ChDir "R:\James Walker\Garry\Forecasting Tool\Data file"
    Workbooks.Open Filename:= _
        "R:\James Walker\Garry\Forecasting Tool\Data file\SM Reports UK.xlsx"
        
    Application.CutCopyMode = False
    'ActiveSheet.ShowAllData
    
'---------Check for Filters in SM Reports UK------


If ActiveSheet.AutoFilterMode Then 'autofilter is 'on'
   On Error Resume Next   'turn off error reporting
   ActiveSheet.ShowAllData
   On Error GoTo 0   'turn error reporting back on
End If
        
'----------Copy new APL file over to current file-------


    Range("A7:AX7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Rolling intake tracker test.xlsb").Activate
    Sheet8.Select
    Range("A2").Select
    ActiveSheet.Paste
    
' Close new APL file
    
    Windows("SM Reports UK.xlsx").Activate
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A2").Select


    
'---------Removing the time form the dates----------


    Windows("Rolling intake tracker test.xlsb").Activate
    Columns("Y:Y").Select
    Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("AB:AB").Select
    Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D:D").Select
    Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Range("A2").Select
    
'-----------Adding the for formulas-------------


    Dim lastRow As Long
    
    With Sheets("APL file")
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        '-------- Brand & Week ---------
        .Range("BE2:BE" & lastRow).Formula = "=CONCATENATE(RC[-20]&RC[-3])"
        '-------- container info ---------
        .Range("BD2:BD" & lastRow).Formula = "=IF(RC[-45]="""","""",RC[-19]&RC[-46])"
        '-------- Hanging ---------
        .Range("AZ2:AZ" & lastRow).Formula = "=IF(RC[-12]=""GOH"",RC[-11],"""")"
        '-------- BOXED ---------
        .Range("AY2:AY" & lastRow).Formula = "=IF(RC[-11]=""BOXED"",IF(RC[-9]="""",ROUNDUP(RC[-10]/VLOOKUP(RC[6],'Carton mix'!C[-48]:C[-47],2,0),0),RC[-9]),"" "")"
        '-------- Inbound date ---------
        .Range("BA2:BA" & lastRow).Formula = "=IFERROR(IF(RC[-28]="""",IF(RC[-35]="""",SUM(RC[-39]+VLOOKUP(RC[-50],'Transit Time '!R2C1:R31C3,3,0)),SUM(RC[-35]+'Transit Time '!R3C5)),RC[-28]),"" "")"
        '-------- Week number ---------
        .Range("BB2:BB" & lastRow).Formula = "=IFERROR(VLOOKUP(RC[-1],DATES!C[-53]:C[-52],2,0),"" "")"
        '-------- Month & Year ---------
        .Range("BC2:BC" & lastRow).Formula = "=IFERROR(VLOOKUP(RC[-2],'DATES'!C[-54]:C[-50],5,0),"" "")"
        '-------- Conainter count (by DC) ---------
        .Range("BF2:BF" & lastRow).Formula = "=IF(RC[-48]="""","""",IF(SUMPRODUCT((R2C46:RC46=RC[-12])*(R2C10:RC10=RC[-48]))>1,0,1))"
        '-------- Booked YES or NO ---------
        .Range("BG2:BG" & lastRow).Formula = "=IFERROR(IF(RC[-34]="""",""NO"",""YES""),"""")"
        '-------- Conainter count (by brand) ---------
        .Range("BH2:BH" & lastRow).Formula = "=IF(RC[-50]="""","""",IF(SUMPRODUCT((R2C37:RC37=RC[-23])*(R2C10:RC10=RC[-50]))>1,0,1))"
        '-------- Days at port  ---------
        .Range("BI2:BI" & lastRow).Formula = "=R1C63-RC[-41]"
        '-------- Day at port lookup ---------
        .Range("BJ2:BJ" & lastRow).Formula = "=IF(RC[-1]<=6,""Less than 7 days"",IF(AND(RC[-1]>=7,RC[-1]<=14),""7 to 14 days"",IF(AND(RC[-1]>=15,RC[-1]<=28),""15 to 28 days"",IF(RC[-1]>28,""Over 28 days"",""test""))))"
        
        Range("AY3").Select
    End With
    
'----------------- Remove formulas ---------------------
    
        FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
        
        Range("AY2:AY" & FinalRow).Value = Range("AY2:AY" & FinalRow).Value
        Range("AZ2:AZ" & FinalRow).Value = Range("AZ2:AZ" & FinalRow).Value
        Range("BA2:BA" & FinalRow).Value = Range("BA2:BA" & FinalRow).Value
        Range("BB2:BB" & FinalRow).Value = Range("BB2:BB" & FinalRow).Value
        Range("BC2:BC" & FinalRow).Value = Range("BC2:BC" & FinalRow).Value
        Range("BD2:BD" & FinalRow).Value = Range("BD2:BD" & FinalRow).Value
        Range("BE2:BE" & FinalRow).Value = Range("BE2:BE" & FinalRow).Value
        Range("BF2:BF" & FinalRow).Value = Range("BF2:BF" & FinalRow).Value
        Range("BG2:BG" & FinalRow).Value = Range("BG2:BG" & FinalRow).Value
        Range("BH2:BH" & FinalRow).Value = Range("BH2:BH" & FinalRow).Value
        Range("BI2:BI" & FinalRow).Value = Range("BI2:BI" & FinalRow).Value
        Range("BJ2:BJ" & FinalRow).Value = Range("BJ2:BJ" & FinalRow).Value
    
'
' -------------------------------- UPDATEING PORT AND CONATINER INFO FILE (APL TAB) --------------------------------
'
    
'--------------Open new port and container info file-------------------


    ChDir "R:\James Walker\Garry\Forecasting Tool\Data file"
    Workbooks.Open Filename:= _
        "R:\James Walker\Garry\Forecasting Tool\Data file\port and container info.xlsx"
    
'--------------Delete old APL data--------------


    Windows("port and container info.xlsx").Activate
    Sheets("APL file").Select
    Range("A2:BF2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 1
    Range("A2").Select
    
'--------------Copy APL info over to port and container info--------------


    Windows("Rolling intake tracker test.xlsb").Activate
    Sheets("APL file").Select
    Range("A2:BF2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("port and container info.xlsx").Activate
    Sheets("APL file").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    
'--------- Refresh all tables ----------
    
 ActiveWorkbook.RefreshAll
 
'--------- save port and container info update ----------
 
 ActiveWorkbook.Save
  
'-----------Close port and container info file------------
    
    Windows("port and container info.xlsx").Activate
    ActiveWindow.Close
    
'
' -------------------------------- UPDATEING FORECAST V2 FILE --------------------------------
'
    
'--------------Open forecast v2 file-------------------


    ChDir "R:\James Walker\Garry\Forecasting Tool\Data file\forecast"
    Workbooks.Open Filename:= _
        "R:\James Walker\Garry\Forecasting Tool\Data file\forecast\Forecast v2.xlsx"
        
'--------- Refresh all tables ----------
    
    ActiveWorkbook.RefreshAll
        
'--------- save port and container info update ----------
 
    ActiveWorkbook.Save
        
'-----------Close forecast v2 file------------
    
    ActiveWindow.Close
        
'
' -------------------------------- BACK TP ROLLING INTAKE TRACKER --------------------------------
'
    Range("A2").Select
    Windows("Rolling intake tracker test.xlsb").Activate
    Sheets("Summary Data Sea ").Select
    Range("A1").Select
    
    
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With




MsgBox "The Updated have now been completed"


    
End Sub