Optimize vba code(mostly filters) so it is more efficient.

Hello to all,

I'm not much on vba(like you won't be able to tell) this code works in a timely fashion on new pc's but not so much on old pc's. Old pc's it works it just takes a while, so i thought i would see if anyone could get the code to be more efficient which i'm sure it can be. I've attached my workbook and pasted the macro that i have.

scan checker.zip

Sub FilterJuly2()

' FilterJuly2 Macro

    Dim LastRow As Long
    
    LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    
    
    'keep screen from updating while the macro runs
    Application.ScreenUpdating = False
    'start filter for arrivals before 10:00
    Sheets("Labels from thumb drive").Select
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=4, Criteria1:="7"
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=3, Criteria1:="<10:00", _
        Operator:=xlAnd
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'paste the arrivals to the arrivals sheet
    Sheets("Arrivals").Select
    Range("B3").Select
    ActiveSheet.Paste
    'formula to check arrivals against stc
    Range("A4").Select
    Selection.FormulaArray = _
        "=IF(RC[1]="""","""",IF(RC[11]=82,1,SUMPRODUCT(--(RIGHT(STC!R4C2:R10000C2,20)=RIGHT(RC[1],20)))))"
    Selection.AutoFill Destination:=Range("A4:A" & LastRow)
    'filter everything but arrivals and accepted
    Sheets("Labels from thumb drive").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=4, Criteria1:="<>7", _
        Operator:=xlAnd, Criteria2:="<>3"
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'paste all but 7 and 3 into the STC sheet
    Sheets("STC").Select
    Range("B2").Select
    ActiveSheet.Paste
    'formula to check stc against arrivals
    Range("A4").Select
    Selection.FormulaArray = _
        "=IF(RC[1]="""","""",IF(RC[11]=82,1,SUMPRODUCT(--(RIGHT(Arrivals!R4C2:R10000C2,20)=RIGHT(RC[1],20)))))"
    Selection.AutoFill Destination:=Range("A4:A" & LastRow)
    'filter the route assignment labels
    Sheets("Labels from thumb drive").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=11, Criteria1:="82"
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'paste route assign numbers to the route assignment sheet
    Sheets("Route Assignments").Select
    Range("B3").Select
    ActiveSheet.Paste
    'turn filter off
    Sheets("Labels from thumb drive").Select
    Selection.AutoFilter
    Range("B4").Select
    
    'filter labels that have 0 result and paste to arrive with no stc
    Sheets("Arrivals").Select
    Range("A4:A10000").Select
    Selection.AutoFilter
    ActiveSheet.Range("A4:A" & LastRow).AutoFilter Field:=1, Criteria1:="0"
    Range("B3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Arrive with no STC").Select
    Range("B3").Select
    ActiveSheet.Paste
    'formula to parse out the route id of the assign label
    Sheets("Route Assignments").Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[1]="""","""",MID(RC[1],14,5)&"" ""&LOOKUP(MID(RC[1],19,1),{""1"",""2"",""4""},{""C"",""R"",""B""})&0&MID(RC[1],20,2))"
    Selection.AutoFill Destination:=Range("A4:A" & LastRow)
    'formula for knowing which route label was assigned to
    Sheets("Arrive with no STC").Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(IF(RC[1]="""","""",INDEX('Route Assignments'!R4C1:R10000C1,MATCH('Arrive with no STC'!RC[3],'Route Assignments'!R4C4:R10000C4,0)))),""Not Assigned"",IF(RC[1]="""","""",INDEX('Route Assignments'!R4C1:R10000C1,MATCH('Arrive with no STC'!RC[3],'Route Assignments'!R4C4:R10000C4,0))))"
    Selection.AutoFill Destination:=Range("A4:A" & LastRow)
    'filter stc with no arrive and paste to stc with no arrive sheet
    Sheets("STC").Select
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("A4:A" & LastRow).AutoFilter Field:=1, Criteria1:="0"
    Range("B2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("STC with no Arrive").Select
    Range("B2").Select
    ActiveSheet.Paste
    Sheets("Arrivals").Select
    Selection.AutoFilter
    Sheets("STC").Select
    Selection.AutoFilter
    
    
    Sheets("Home").Select
    Range("H11").Select
    'update the screen
    Application.ScreenUpdating = True
    
End Sub

okay lets shorten this up. is there a better way to write this part of the code.

 Sheets("Labels from thumb drive").Select
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=4, Criteria1:="7"
    ActiveSheet.Range("B4:P10000").AutoFilter Field:=3, Criteria1:="<10:00", _
        Operator:=xlAnd
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'paste the arrivals to the arrivals sheet
    Sheets("Arrivals").Select
    Range("B3").Select
    ActiveSheet.Paste