Sub WAFCO_Tracking_Cleanup()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rowcount As Integer
Dim MainWS As Worksheet, CarrierWS As Worksheet
Dim RW As Range
Dim Carrier As String
Set MainWS = Sheets("Sheet1")

Range("R:R").EntireColumn.Delete
Range("O:O").EntireColumn.Delete
Range("J:K").EntireColumn.Delete
Range("A:F").EntireColumn.Delete




Range("B1").Value = "PRO#"
Range("C1").Value = "BOL#"
Range("D1").Value = "Status"
Range("E1").Value = "Ship Date"

Range("F1").Value = "Dely Date"
Range("G1").Value = "Origin"
Range("H1").Value = "Destination"


rowcount = MainWS.UsedRange.Rows.Count


For i = 2 To rowcount
        If Cells(i, 4).Value = "Shipment Delivered" Then
        Rows(i).Delete

        End If

    Next

    MainWS.Sort.SortFields.Clear
    MainWS.Sort.SortFields.Add2 Key:=Range("A2:A" & rowcount), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    MainWS.Sort.SortFields.Add2 Key:=Range("E2:E" & rowcount), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With MainWS.Sort
        .SetRange Range("A1:H" & rowcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


MainWS.Columns("A:Z").AutoFit

Const CarCol = 1, AddrCol = 2, CityCol = 3, StateCol = 4, ZipCol = 5, DateCol = 6



    For Each RW In MainWS.UsedRange.Rows
        Set CarrierWS = Nothing
        If RW.Row > 1 Then     ' don't do the header row
            Carrier = RW.Columns(CarCol).Value

            On Error Resume Next
                Set CarrierWS = Sheets(Carrier)
            On Error GoTo 0

            If CarrierWS Is Nothing Then  ' the WS does not exist
                Sheets.Add    ' this will change the active sheet
                Set CarrierWS = ActiveSheet
                CarrierWS.Name = Carrier
                MainWS.UsedRange.Rows(1).Copy  ' i am assuming you have a header row
                CarrierWS.Paste              ' that you want to copy to the new sheet
                CarrierWS.Range("A1:H1").Interior.ColorIndex = 37
TheWall

            Else
                CarrierWS.Activate
            End If  ' sheet not exist

            CarrierWS.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Activate   ' go to the first empty row
            RW.Copy   ' copy the row from the main sheet
            CarrierWS.Paste
TheWall

        End If  ' header row
    Next RW

    For Each CarrierWS In Sheets
        If CarrierWS.Name <> MainWS.Name Then   ' Don't sort the main sheet
            CarrierWS.Sort.SortFields.Clear
            CarrierWS.Sort.SortFields.Add2 Key:=CarrierWS.Columns(DateCol), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With CarrierWS.Sort
                .SetRange CarrierWS.UsedRange
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
CarrierWS.Columns("A:Z").AutoFit

        End If
        Dim iCntr, sht

'This will hold the colorIndex number
iCntr = 2

'looping throgh the all the sheets of the workbook
For Each sht In ActiveWorkbook.Worksheets
    iCntr = iCntr + 1

    'Applying the colors to Sheet tabs
    sht.Tab.ColorIndex = iCntr
Next
    Next CarrierWS




Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub



Sub TheWall()

Application.ScreenUpdating = False
Dim lngLstCol As Long, lngLstRow As Long

lngLstRow = ActiveSheet.UsedRange.Rows.Count
lngLstCol = ActiveSheet.UsedRange.Columns.Count

For Each rngCell In Range("A2:A" & lngLstRow)
    If rngCell.Value > "" Then
        r = rngCell.Row
        c = rngCell.Column
        Range(Cells(r, c), Cells(r, lngLstCol)).Select
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
    End If
Next
Application.ScreenUpdating = True

End Sub



Sub ColorAllTabs()
'Declaration
Dim iCntr, sht

'This will hold the colorIndex number
iCntr = 2

'looping throgh the all the sheets of the workbook
For Each sht In ActiveWorkbook.Worksheets
    iCntr = iCntr + 1

    'Applying the colors to Sheet tabs
    sht.Tab.ColorIndex = iCntr
Next

End Sub