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
Bookmarks