Option Explicit

Sub OTD_FINAL_PROCESSOR()

    Dim fp As Object
    Dim folderPath As String
    Dim fso As Object
    Dim folderObj As Object
    Dim fileObj As Object
    Dim fileName As String
    Dim fullPath As String
    Dim fileExtension As String

    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim candidateWS As Worksheet
    Dim masterWS As Worksheet
    Dim summaryWS As Worksheet
    Dim carrierWS As Worksheet
    Dim existingWS As Worksheet
    Dim ws As Worksheet

    Dim headerRow As Long
    Dim firstDataRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim masterNextRow As Long
    Dim summaryNextRow As Long

    Dim carrierCol As Long
    Dim shipmentDateCol As Long
    Dim agreedTTCol As Long
    Dim actualTTCol As Long
    Dim varianceCol As Long
    Dim reasonLateCol As Long

    Dim pickupDateCol As Long
    Dim departureDateCol As Long
    Dim arrivalPortDateCol As Long
    Dim arrivalConsigneeDateCol As Long

    Dim rowNumber As Long
    Dim sheetNumber As Long
    Dim searchRow As Long
    Dim searchCol As Long

    Dim carrierName As String
    Dim carrierSheetName As String
    Dim baseSheetName As String
    Dim suffixNumber As Long

    Dim shipmentCount As Long
    Dim missingAgreedTT As Long
    Dim missingActualTT As Long
    Dim missingReasonLate As Long
    Dim dateFormatIssue As Long
    Dim totalIssues As Long

    Dim dateColumns As Variant
    Dim dateColumn As Variant
    Dim visibleDate As String
    Dim dateOnly As String

    Dim varianceValue As Variant
    Dim reasonValue As Variant
    Dim reasonText As String

    Dim shipmentDateValue As Date
    Dim validShipmentDate As Boolean
    Dim validShipmentRow As Boolean
    Dim dataSheetFound As Boolean

    Dim lastUsedCell As Range
    Dim lastHeaderCell As Range

    On Error GoTo ProcessorError

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.CutCopyMode = False

    Set fp = Application.FileDialog(4)

    fp.Title = "Select the folder containing the OTD carrier reports"
    fp.AllowMultiSelect = False

    If fp.Show <> -1 Then
        GoTo SafeExit
    End If

    folderPath = fp.SelectedItems(1)

    Set masterWS = Nothing
    Set summaryWS = Nothing

    On Error Resume Next
    Set masterWS = ThisWorkbook.Worksheets("Master Report")
    Set summaryWS = ThisWorkbook.Worksheets("Carrier Summary")
    On Error GoTo ProcessorError

    If masterWS Is Nothing Then
        Set masterWS = ThisWorkbook.Worksheets.Add
        masterWS.Name = "Master Report"
    End If

    If summaryWS Is Nothing Then
        Set summaryWS = ThisWorkbook.Worksheets.Add(After:=masterWS)
        summaryWS.Name = "Carrier Summary"
    End If

    For sheetNumber = ThisWorkbook.Worksheets.Count To 1 Step -1

        Set ws = ThisWorkbook.Worksheets(sheetNumber)

        If LCase(ws.Name) <> "master report" Then
    If LCase(ws.Name) <> "carrier summary" Then
        If LCase(ws.Name) <> "carrier follow up" Then
            If LCase(ws.Name) <> "reason mapping" Then
                If LCase(ws.Name) <> "reason analysis" Then
                    If LCase(ws.Name) <> "reason category analysis" Then
                        If LCase(ws.Name) <> "read me" Then
                            If LCase(ws.Name) <> "instructions" Then
                                ws.Delete
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End If

    Next sheetNumber

    masterWS.Cells.Clear
    summaryWS.Cells.Clear

    masterNextRow = 1
    summaryNextRow = 2

    summaryWS.Cells(1, 1).Value = "Carrier"
    summaryWS.Cells(1, 2).Value = "Shipments"
    summaryWS.Cells(1, 3).Value = "Missing Agreed TT"
    summaryWS.Cells(1, 4).Value = "Missing Actual TT"
    summaryWS.Cells(1, 5).Value = "Missing Reason For Late"
    summaryWS.Cells(1, 6).Value = "Date Format Issue"
    summaryWS.Cells(1, 7).Value = "Total Issues"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folderObj = fso.GetFolder(folderPath)

    For Each fileObj In folderObj.Files

        fileName = CStr(fileObj.Name)
        fileExtension = LCase(CStr(fso.GetExtensionName(fileName)))

        If Left(fileName, 2) <> "~$" Then

            If fileName <> ThisWorkbook.Name Then

                If fileExtension = "xlsx" Or _
                   fileExtension = "xlsm" Or _
                   fileExtension = "xls" Then

                    fullPath = CStr(fileObj.Path)

                    Set sourceWB = Workbooks.Open( _
                        fileName:=fullPath, _
                        ReadOnly:=True, _
                        UpdateLinks:=False)

                    Set sourceWS = Nothing
                    dataSheetFound = False
                    headerRow = 0

                    For Each candidateWS In sourceWB.Worksheets

                        For searchRow = 1 To 20

                            For searchCol = 1 To 30

                                If Not IsError(candidateWS.Cells(searchRow, searchCol).Value) Then

                                    If LCase(Trim(CStr( _
                                        candidateWS.Cells(searchRow, searchCol).Value))) = _
                                        "freight forwarder" Then

                                        Set sourceWS = candidateWS
                                        headerRow = searchRow
                                        dataSheetFound = True
                                        Exit For

                                    End If

                                End If

                            Next searchCol

                            If dataSheetFound = True Then Exit For

                        Next searchRow

                        If dataSheetFound = True Then Exit For

                    Next candidateWS

                    If dataSheetFound = False Then

                        sourceWB.Close SaveChanges:=False
                        Set sourceWB = Nothing

                    Else

                        carrierCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Freight Forwarder"))

                        shipmentDateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Shipment Date"))

                        agreedTTCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Agreed Transit Time"))

                        actualTTCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Actual Transit Time"))

                        varianceCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array( _
                                "Actual Transit Time v Agreed Transit Time", _
                                "Actual Transit Time vs Agreed Transit Time"))

                        reasonLateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Reason for Late"))

                        pickupDateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array( _
                                "Actual Pick-Up Date", _
                                "Actual Pick Up Date"))

                        departureDateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Actual Departure from Origin Port"))

                        arrivalPortDateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Actual Arrival to Destination Port"))

                        arrivalConsigneeDateCol = OTD_FindHeaderColumn( _
                            sourceWS, headerRow, _
                            Array("Actual Arrival to Consignee"))

                        firstDataRow = headerRow + 1

                        carrierName = ""

                        If carrierCol > 0 Then

                            If Not IsError(sourceWS.Cells(firstDataRow, carrierCol).Value) Then
                                carrierName = Trim(CStr( _
                                    sourceWS.Cells(firstDataRow, carrierCol).Value))
                            End If

                        End If

                        If carrierName = "" Then

                            carrierName = fso.GetBaseName(fileName)

                            carrierName = Replace( _
                                carrierName, "OTD-", "", _
                                1, -1, vbTextCompare)

                            carrierName = Replace( _
                                carrierName, "OTD_", "", _
                                1, -1, vbTextCompare)

                        End If

                        carrierSheetName = carrierName

                        carrierSheetName = Replace(carrierSheetName, "/", "-")
                        carrierSheetName = Replace(carrierSheetName, "\", "-")
                        carrierSheetName = Replace(carrierSheetName, ":", "-")
                        carrierSheetName = Replace(carrierSheetName, Chr(42), "-")
                        carrierSheetName = Replace(carrierSheetName, "?", "-")
                        carrierSheetName = Replace(carrierSheetName, "[", "-")
                        carrierSheetName = Replace(carrierSheetName, "]", "-")

                        If Len(carrierSheetName) > 31 Then
                            carrierSheetName = Left(carrierSheetName, 31)
                        End If

                        baseSheetName = carrierSheetName
                        suffixNumber = 1

                        Do
Do

    Set existingWS = Nothing

    On Error Resume Next
    Set existingWS = ThisWorkbook.Worksheets(carrierSheetName)
    On Error GoTo ProcessorError

    If existingWS Is Nothing Then Exit Do

    suffixNumber = suffixNumber + 1

    carrierSheetName = _
        Left(baseSheetName, 27) & _
        "_" & CStr(suffixNumber)

Loop
                            
                        Loop

                        Set carrierWS = ThisWorkbook.Worksheets.Add( _
                            After:=ThisWorkbook.Worksheets( _
                                ThisWorkbook.Worksheets.Count))

                        carrierWS.Name = carrierSheetName

                        Set lastUsedCell = sourceWS.Cells.Find( _
                            What:=Chr(42), _
                            After:=sourceWS.Cells(1, 1), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)

                        Set lastHeaderCell = sourceWS.Cells.Find( _
                            What:=Chr(42), _
                            After:=sourceWS.Cells(1, 1), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)

                        If lastUsedCell Is Nothing Then

                            sourceWB.Close SaveChanges:=False
                            Set sourceWB = Nothing

                        ElseIf lastHeaderCell Is Nothing Then

                            sourceWB.Close SaveChanges:=False
                            Set sourceWB = Nothing

                        Else

                            lastRow = lastUsedCell.Row
                            lastCol = lastHeaderCell.Column

                            sourceWS.Range( _
                                sourceWS.Cells(headerRow, 1), _
                                sourceWS.Cells(lastRow, lastCol)).Copy

                            carrierWS.Cells(1, 1).PasteSpecial _
                                Paste:=xlPasteValuesAndNumberFormats

                            If masterNextRow = 1 Then

                                sourceWS.Range( _
                                    sourceWS.Cells(headerRow, 1), _
                                    sourceWS.Cells(headerRow, lastCol)).Copy

                                masterWS.Cells(1, 1).PasteSpecial _
                                    Paste:=xlPasteValuesAndNumberFormats

                                masterNextRow = 2

                            End If

                            If lastRow >= firstDataRow Then

                                sourceWS.Range( _
                                    sourceWS.Cells(firstDataRow, 1), _
                                    sourceWS.Cells(lastRow, lastCol)).Copy

                                masterWS.Cells(masterNextRow, 1).PasteSpecial _
                                    Paste:=xlPasteValuesAndNumberFormats

                                masterNextRow = masterWS.Cells( _
                                    masterWS.Rows.Count, 1).End(xlUp).Row + 1

                            End If

                            shipmentCount = 0
                            missingAgreedTT = 0
                            missingActualTT = 0
                            missingReasonLate = 0
                            dateFormatIssue = 0

                            dateColumns = Array( _
                                shipmentDateCol, _
                                pickupDateCol, _
                                departureDateCol, _
                                arrivalPortDateCol, _
                                arrivalConsigneeDateCol)

                            For rowNumber = firstDataRow To lastRow

                                validShipmentRow = False

                                If sourceWS.Rows(rowNumber).Hidden = False Then

                                    If carrierCol > 0 Then

                                        If Trim(CStr( _
                                            sourceWS.Cells( _
                                                rowNumber, carrierCol).Text)) <> "" Then

                                            validShipmentRow = True

                                        End If

                                    End If

                                End If

                                If validShipmentRow = True Then

                                    shipmentCount = shipmentCount + 1

                                    If agreedTTCol > 0 Then

                                        If Trim(CStr( _
                                            sourceWS.Cells( _
                                                rowNumber, agreedTTCol).Text)) = "" Then

                                            missingAgreedTT = _
                                                missingAgreedTT + 1

                                        End If

                                    End If

                                    If actualTTCol > 0 Then

                                        If Trim(CStr( _
                                            sourceWS.Cells( _
                                                rowNumber, actualTTCol).Text)) = "" Then

                                            missingActualTT = _
                                                missingActualTT + 1

                                        End If

                                    End If

                                    For Each dateColumn In dateColumns

                                        If CLng(dateColumn) > 0 Then

                                            visibleDate = Trim(CStr( _
                                                sourceWS.Cells( _
                                                    rowNumber, CLng(dateColumn)).Text))

                                            visibleDate = Replace( _
                                                visibleDate, Chr(160), " ")

                                            visibleDate = Replace( _
                                                visibleDate, vbTab, " ")

                                            visibleDate = Trim(visibleDate)

                                            If visibleDate <> "" Then

                                                dateOnly = visibleDate

                                                If InStr(1, dateOnly, " ") > 0 Then
                                                    dateOnly = Split(dateOnly, " ")(0)
                                                End If

                                                If OTD_DateFormatValid(dateOnly) = False Then
                                                    dateFormatIssue = 1
                                                End If

                                            End If

                                        End If

                                    Next dateColumn

                                    validShipmentDate = False

                                    If shipmentDateCol > 0 Then

                                        validShipmentDate = OTD_GetShipmentDate( _
                                            sourceWS.Cells( _
                                                rowNumber, shipmentDateCol), _
                                            shipmentDateValue)

                                    End If

                                    If validShipmentDate = True Then

                                        If shipmentDateValue >= DateSerial(2026, 6, 1) Then

                                            If varianceCol > 0 Then

                                                If reasonLateCol > 0 Then

                                                    varianceValue = sourceWS.Cells( _
                                                        rowNumber, varianceCol).Value2

                                                    reasonValue = sourceWS.Cells( _
                                                        rowNumber, reasonLateCol).Value2

                                                    If IsError(reasonValue) Then
                                                        reasonText = ""
                                                    Else
                                                        reasonText = Trim(CStr(reasonValue))
                                                    End If

                                                    If Not IsError(varianceValue) Then

                                                        If IsNumeric(varianceValue) Then

                                                            If CDbl(varianceValue) > 0 Then

                                                                If reasonText = "" Then

                                                                    missingReasonLate = _
                                                                        missingReasonLate + 1

                                                                End If

                                                            End If

                                                        End If

                                                    End If

                                                End If

                                            End If

                                        End If

                                    End If

                                End If

                            Next rowNumber

                            totalIssues = _
                                missingAgreedTT + _
                                missingActualTT + _
                                missingReasonLate + _
                                dateFormatIssue

                            summaryWS.Cells( _
                                summaryNextRow, 1).Value = carrierName

                            summaryWS.Cells( _
                                summaryNextRow, 2).Value = shipmentCount

                            summaryWS.Cells( _
                                summaryNextRow, 3).Value = missingAgreedTT

                            summaryWS.Cells( _
                                summaryNextRow, 4).Value = missingActualTT

                            summaryWS.Cells( _
                                summaryNextRow, 5).Value = missingReasonLate

                            If dateFormatIssue = 1 Then
                                summaryWS.Cells(summaryNextRow, 6).Value = "Yes"
                            Else
                                summaryWS.Cells(summaryNextRow, 6).Value = "No"
                            End If

                            summaryWS.Cells( _
                                summaryNextRow, 7).Value = totalIssues

                            With carrierWS.UsedRange

                                .Interior.Pattern = xlNone
                                .Font.Name = "Calibri"
                                .Font.Size = 11
                                .Font.Color = RGB(0, 0, 0)

                            End With

                            With carrierWS.Rows(1)

                                .Font.Bold = True
                                .Font.Color = RGB(255, 255, 255)
                                .Interior.Color = RGB(31, 78, 121)

                            End With

                            carrierWS.Columns.AutoFit

                            summaryNextRow = summaryNextRow + 1

                            sourceWB.Close SaveChanges:=False
                            Set sourceWB = Nothing

                        End If

                    End If

                End If

            End If

        End If


    Next fileObj

    With masterWS.UsedRange

        .Interior.Pattern = xlNone
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Font.Color = RGB(0, 0, 0)

    End With

    With masterWS.Rows(1)

        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(31, 78, 121)

    End With

    With summaryWS.UsedRange

        .Interior.Pattern = xlNone
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Font.Color = RGB(0, 0, 0)

    End With

    With summaryWS.Rows(1)

        .Font.Bold = True
        .Font.Color = RGB(255, 255, 255)
        .Interior.Color = RGB(31, 78, 121)

    End With

    masterWS.Columns.AutoFit
    summaryWS.Columns.AutoFit

    MsgBox "OTD Processor Complete"

SafeExit:

    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    Exit Sub

ProcessorError:

    MsgBox _
        "The processor stopped while reading:" & vbCrLf & _
        fileName & vbCrLf & vbCrLf & _
        "Error " & Err.Number & ": " & Err.Description

    If Not sourceWB Is Nothing Then
        sourceWB.Close SaveChanges:=False
    End If

    Resume SafeExit

End Sub

Private Function OTD_FindHeaderColumn( _
    ByVal targetWS As Worksheet, _
    ByVal targetHeaderRow As Long, _
    ByVal possibleHeaders As Variant) As Long

    Dim columnNumber As Long
    Dim headerOption As Variant
    Dim headerText As String
    Dim finalColumn As Long

    OTD_FindHeaderColumn = 0

    finalColumn = targetWS.Cells( _
        targetHeaderRow, _
        targetWS.Columns.Count).End(xlToLeft).Column

    For columnNumber = 1 To finalColumn

        If Not IsError( _
            targetWS.Cells( _
                targetHeaderRow, columnNumber).Value) Then

            headerText = LCase(Trim(CStr( _
                targetWS.Cells( _
                    targetHeaderRow, columnNumber).Value)))

            For Each headerOption In possibleHeaders

                If headerText = _
                    LCase(Trim(CStr(headerOption))) Then

                    OTD_FindHeaderColumn = columnNumber
                    Exit Function

                End If

            Next headerOption

        End If

    Next columnNumber

End Function

Private Function OTD_DateFormatValid( _
    ByVal dateText As String) As Boolean

    Dim dateParts As Variant
    Dim monthPart As Long
    Dim dayPart As Long
    Dim yearPart As Long
    Dim testDate As Date

    OTD_DateFormatValid = False

    dateText = Trim(dateText)

    If dateText = "" Then

        OTD_DateFormatValid = True
        Exit Function

    End If

    If InStr(1, dateText, "/") = 0 Then
        Exit Function
    End If

    dateParts = Split(dateText, "/")

    If UBound(dateParts) <> 2 Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(0)) Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(1)) Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(2)) Then
        Exit Function
    End If

    monthPart = CLng(dateParts(0))
    dayPart = CLng(dateParts(1))
    yearPart = CLng(dateParts(2))

    If monthPart < 1 Or monthPart > 12 Then
        Exit Function
    End If

    If dayPart < 1 Or dayPart > 31 Then
        Exit Function
    End If

    If yearPart < 1900 Or yearPart > 2100 Then
        Exit Function
    End If

    On Error GoTo InvalidDate

    testDate = DateSerial(yearPart, monthPart, dayPart)

    If Month(testDate) <> monthPart Then
        Exit Function
    End If

    If Day(testDate) <> dayPart Then
        Exit Function
    End If

    If Year(testDate) <> yearPart Then
        Exit Function
    End If

    OTD_DateFormatValid = True
    Exit Function

InvalidDate:

    OTD_DateFormatValid = False

End Function

Private Function OTD_GetShipmentDate( _
    ByVal dateCell As Range, _
    ByRef parsedDate As Date) As Boolean

    Dim rawValue As Variant
    Dim displayedText As String
    Dim dateOnly As String
    Dim dateParts As Variant

    Dim monthPart As Long
    Dim dayPart As Long
    Dim yearPart As Long

    OTD_GetShipmentDate = False

    rawValue = dateCell.Value2

    If IsError(rawValue) Then
        Exit Function
    End If

    If IsNumeric(rawValue) Then

        If CDbl(rawValue) > 0 Then

            On Error GoTo InvalidShipmentDate

            parsedDate = CDate(rawValue)
            parsedDate = DateSerial( _
                Year(parsedDate), _
                Month(parsedDate), _
                Day(parsedDate))

            OTD_GetShipmentDate = True
            Exit Function

        End If

    End If

    displayedText = Trim(CStr(dateCell.Text))
    displayedText = Replace(displayedText, Chr(160), " ")
    displayedText = Replace(displayedText, vbTab, " ")
    displayedText = Trim(displayedText)

    If displayedText = "" Then
        Exit Function
    End If

    dateOnly = displayedText

    If InStr(1, dateOnly, " ") > 0 Then
        dateOnly = Split(dateOnly, " ")(0)
    End If

    dateOnly = Trim(dateOnly)

    If InStr(1, dateOnly, "/") = 0 Then
        Exit Function
    End If

    dateParts = Split(dateOnly, "/")

    If UBound(dateParts) <> 2 Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(0)) Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(1)) Then
        Exit Function
    End If

    If Not IsNumeric(dateParts(2)) Then
        Exit Function
    End If

    monthPart = CLng(dateParts(0))
    dayPart = CLng(dateParts(1))
    yearPart = CLng(dateParts(2))

    If monthPart < 1 Or monthPart > 12 Then
        Exit Function
    End If

    If dayPart < 1 Or dayPart > 31 Then
        Exit Function
    End If

    If yearPart < 1900 Or yearPart > 2100 Then
        Exit Function
    End If

    On Error GoTo InvalidShipmentDate

    parsedDate = DateSerial(yearPart, monthPart, dayPart)

    If Month(parsedDate) <> monthPart Then
        Exit Function
    End If

    If Day(parsedDate) <> dayPart Then
        Exit Function
    End If

    If Year(parsedDate) <> yearPart Then
        Exit Function
    End If

    OTD_GetShipmentDate = True
    Exit Function

InvalidShipmentDate:

    OTD_GetShipmentDate = False

End Function