Bncc

Sub BNCCMacro()
    Dim wsOrders As Worksheet
    Dim wsRegions As Worksheet
    Dim wsCarriers As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim orderDict As Object
    Dim currentSCAC As String
    Dim currentRegionCode As String
    Dim carrierEmail As Variant
    Dim regionEmail As Variant
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim emailBody As String
    Dim emailSubject As String
    Dim key As Variant
    Dim splitKey() As String
    Dim dictKey As String
    Dim regionEmailDict As Object

    ' Initialize worksheets
    Set wsOrders = ThisWorkbook.Sheets("Orders")
    Set wsRegions = ThisWorkbook.Sheets("Regions")
    Set wsCarriers = ThisWorkbook.Sheets("Carriers")

    ' Create dictionaries
    Set orderDict = CreateObject("Scripting.Dictionary")
    Set regionEmailDict = CreateObject("Scripting.Dictionary")

    ' Load region email data into dictionary
    lastRow = wsRegions.Cells(wsRegions.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        regionEmailDict(CStr(wsRegions.Cells(i, 1).Value)) = wsRegions.Cells(i, 2).Value
    Next i

    ' Debug: Print all region emails
    Debug.Print "Region Code to Email Mapping:"
    For Each key In regionEmailDict.Keys
        Debug.Print "Region Code: " & key & ", Email: " & regionEmailDict(key)
    Next key

    ' Read orders and group by SCAC and region email
    lastRow = wsOrders.Cells(wsOrders.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        currentSCAC = wsOrders.Cells(i, 3).Value
        currentRegionCode = CStr(wsOrders.Cells(i, 1).Value) ' Ensure region code is treated as string

        ' Find carrier email
        carrierEmail = Application.VLookup(currentSCAC, wsCarriers.Range("A1:B300"), 2, False)
        If IsError(carrierEmail) Then
            carrierEmail = ""
        End If

        ' Find region email
        If regionEmailDict.exists(currentRegionCode) Then
            regionEmail = regionEmailDict(currentRegionCode)
        Else
            regionEmail = ""
        End If

        ' Debug information
        Debug.Print "Processing Order: " & wsOrders.Cells(i, 2).Value
        Debug.Print "SCAC: " & currentSCAC
        Debug.Print "Region Code: " & currentRegionCode
        Debug.Print "Carrier Email: " & carrierEmail
        Debug.Print "Region Email: " & regionEmail

        If carrierEmail <> "" And regionEmail <> "" Then
            ' Create a key for SCAC and region email grouping
            dictKey = carrierEmail & "|" & regionEmail & "|" & currentSCAC

            If Not orderDict.exists(dictKey) Then
                orderDict.Add dictKey, CreateObject("Scripting.Dictionary")
            End If

            ' Append order to the list
            If Not orderDict(dictKey).exists(currentSCAC) Then
                orderDict(dictKey).Add currentSCAC, ""
            End If

            orderDict(dictKey)(currentSCAC) = orderDict(dictKey)(currentSCAC) & "<li>" & wsOrders.Cells(i, 2).Value & "</li>"
        End If
    Next i

    ' Set up Outlook application
    On Error Resume Next
    Set outlookApp = CreateObject("Outlook.Application")
    If outlookApp Is Nothing Then
        MsgBox "Outlook is not available. Please ensure Outlook is installed and accessible.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    ' Send emails based on grouped data
    For Each key In orderDict.Keys
        splitKey = Split(key, "|")

        carrierEmail = splitKey(0)
        regionEmail = splitKey(1)
        currentSCAC = splitKey(2)

        ' Build email body with HTML formatting
        emailBody = "<html><body>" & _
                    "<p><strong>" & currentSCAC & " Team,</strong></p>" & _
                    "<p>The following orders are showing billed but not picked up. Please advise status or if any issues:</p>" & _
                    "<ul>" & orderDict(key)(currentSCAC) & "</ul>" & _
                    "<p>Thank you,</p>" & _
                    "<p><strong>Tyson</strong></p>" & _
                    "</body></html>"

        emailSubject = "Status Update Request"

        ' Create and send email
        On Error GoTo ErrorHandler
        Set outlookMail = outlookApp.CreateItem(0)
        With outlookMail
            .To = carrierEmail
            .CC = regionEmail
            .Subject = emailSubject
            .HTMLBody = emailBody
            .Send ' Use .Send to send directly
            '.Display ' Use .Display to open the email before sending (commented out)
        End With
        On Error GoTo 0

        ' Optional: Debug message
        Debug.Print "Sent email to: " & carrierEmail & " with CC: " & regionEmail
        Debug.Print "Subject: " & emailSubject
        Debug.Print "Body: " & emailBody
    Next key

    MsgBox "Emails have been successfully grouped and sent.", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred while sending the email. Please check the details and try again.", vbCritical
End Sub