Automated email

Option Explicit
'========================
' Main Macro
'========================
Public Sub Consolidate_Event_Research_And_Process()
    On Error GoTo CleanFail
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Dim downloadsPath As String: downloadsPath = GetDownloadsPath()
    ' --- Locate Event Research file(s) ---
    Dim fileA As String, fileB As String
    If Not PickFilesPerRules(downloadsPath, fileA, fileB) Then
        ' user picks manually (allow 1 or 2)
        If Not PickOneOrTwoFiles(fileA, fileB) Then GoTo CleanFail
    Else
        Dim msg As String, ans As VbMsgBoxResult
        msg = "Use these files?" & vbCrLf & vbCrLf & _
              "1) " & fileA & vbCrLf & _
              "2) " & IIf(Len(fileB) > 0, fileB, "[none]")
        ans = MsgBox(msg, vbQuestion + vbYesNo, "Confirm Event Research Files")
        If ans = vbNo Then
            If Not PickOneOrTwoFiles(fileA, fileB) Then GoTo CleanFail
        End If
    End If
    ' If only one file picked, ask confirmation
    If Len(fileB) = 0 Then
        Dim ans2 As VbMsgBoxResult
        ans2 = MsgBox("Only one file selected." & vbCrLf & _
                      "Continue with this single file?", vbYesNo + vbQuestion, "Confirm Single File")
        If ans2 = vbNo Then
            If Not PickOneOrTwoFiles(fileA, fileB) Then GoTo CleanFail
        End If
    End If
    '=======================
    ' Open file(s)
    '=======================
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Set wbA = Workbooks.Open(Filename:=fileA)
    Set wsA = FirstVisibleSheet(wbA)
    ' --- PRE-CLEAN: remove "Total" footer row from A (if present) ---
    RemoveLastTotalRow wsA
    ' Consolidate if second file present
    If Len(fileB) > 0 Then
        Set wbB = Workbooks.Open(Filename:=fileB)
        Set wsB = FirstVisibleSheet(wbB)
        ' --- PRE-CLEAN: remove "Total" footer row from B (if present) ---
        RemoveLastTotalRow wsB
        ' --- Blind append B -> A ---
        Dim lastRowA As Long, lastColA As Long
        Dim lastRowB As Long, lastColB As Long
        lastRowA = LastUsedRow(wsA)
        lastColA = LastUsedCol(wsA)
        lastRowB = LastUsedRow(wsB)
        lastColB = LastUsedCol(wsB)
        If lastRowB >= 2 And lastColB >= 1 Then
            wsB.Range(wsB.Cells(2, 1), wsB.Cells(lastRowB, lastColB)).Copy _
                Destination:=wsA.Cells(lastRowA + 1, 1)
        End If
        wbB.Close SaveChanges:=False
    End If
    ' Recompute after optional append
    Dim lastRowA As Long, lastColA As Long
    lastRowA = LastUsedRow(wsA)
    lastColA = LastUsedCol(wsA)
    If lastRowA < 1 Or lastColA < 1 Then GoTo AfterProcessing
    '=======================
    ' Delete "Date Last Amount Recorded in ORE"
    '=======================
    Dim oreCol As Long
    oreCol = FindHeaderCol(wsA, "Date Last Amount Recorded in ORE")
    If oreCol > 0 Then
        wsA.Columns(oreCol).EntireColumn.Delete
        lastColA = LastUsedCol(wsA)
    Else
        If Not AskContinue("Header 'Date Last Amount Recorded in ORE' not found. Continue anyway?") Then GoTo AfterProcessing
    End If
    '=======================
    ' Filter blanks in "First Effective Date"
    '=======================
    Dim fedCol As Long
    fedCol = FindHeaderCol(wsA, "First Effective Date")
    Dim filterApplied As Boolean: filterApplied = False
    If fedCol = 0 Then
        If Not AskContinue("Header 'First Effective Date' not found. Continue without filtering?") Then GoTo AfterProcessing
    Else
        Dim dataRange As Range
        Set dataRange = wsA.Range(wsA.Cells(1, 1), wsA.Cells(lastRowA, lastColA))
        dataRange.AutoFilter Field:=fedCol, Criteria1:="="
        filterApplied = True
        If Not HasVisibleDataRows(wsA, dataRange) Then
            If Not AskContinue("'First Effective Date' has no blanks. Continue anyway?") Then
                wsA.AutoFilterMode = False
                GoTo AfterProcessing
            End If
            wsA.AutoFilterMode = False
            filterApplied = False
        End If
    End If
    '=======================
    ' Ensure "Comments" column exists
    '=======================
    Dim commentsCol As Long
    commentsCol = EnsureCommentsColumn(wsA)
    '=======================
    ' Discovery Date checks
    '=======================
    Dim discCol As Long
    discCol = FindHeaderCol(wsA, "Discovery Date")
    If discCol = 0 Then
        If Not AskContinue("Header 'Discovery Date' not found. Continue without 60-day checks?") Then GoTo AfterProcessing
        GoTo SaveAndFinish
    End If
    Dim effDate As Date: effDate = EffectiveDateByShift()
    '=======================
    ' Prepare cumulative workbook
    '=======================
    Dim cumulWB As Workbook, cumulWS As Worksheet
    Dim cumulLoaded As Boolean: cumulLoaded = False
    Dim cumulIdCol As Long
    Dim cumulIdDict As Object
    Dim cumulChanged As Boolean: cumulChanged = False
    Dim evIdCol As Long
    evIdCol = FindHeaderCol(wsA, "Event ID")
    If evIdCol = 0 Then
        If Not AskContinue("Header 'Event ID' not found in consolidated. Continue anyway?") Then GoTo AfterProcessing
    End If
    '=======================
    ' Clear all old Generate data before appending new
    '=======================
    Dim genWS As Worksheet
    Set genWS = ThisWorkbook.Worksheets("Generate")
    ' Clear rows 15 to 500 across first 500 columns
    genWS.Range(genWS.Cells(15, 1), genWS.Cells(500, 500)).ClearContents
    Dim genNextRow As Long: genNextRow = 15
    '=======================
    ' Process each visible row
    '=======================
    Dim r As Long
    For r = 2 To lastRowA
        If wsA.Rows(r).Hidden = False Then
            Dim discVal As Variant: discVal = wsA.Cells(r, discCol).Value
            If IsDate(discVal) Then
                Dim d As Date: d = CDate(discVal)
                If DateDiff("d", d, effDate) < 60 Then
                    wsA.Cells(r, commentsCol).Value = "Less than 60 days"
                Else
                    Dim eventId As String
                    If evIdCol > 0 Then eventId = Trim$(CStr(wsA.Cells(r, evIdCol).Value))
                    If Len(eventId) = 0 Then
                        wsA.Cells(r, commentsCol).Value = "Review Required"
                    Else
                        ' Load cumulative if not yet loaded
                        If Not cumulLoaded Then
                            Set cumulWB = EnsureOpenCumulativeWB()
                            If cumulWB Is Nothing Then
                                wsA.Cells(r, commentsCol).Value = "Review Required"
                            Else
                                Set cumulWS = FirstVisibleSheet(cumulWB)
                                cumulIdCol = FindHeaderCol(cumulWS, "Event ID")
                                Set cumulIdDict = BuildIdDict(cumulWS, cumulIdCol)
                                cumulLoaded = True
                            End If
                        End If
                        Dim inCumulative As Boolean
                        inCumulative = cumulLoaded And cumulIdDict.Exists(LCase$(eventId))
                        If inCumulative Then
                            wsA.Cells(r, commentsCol).Value = "Already available in the cumulative excel"
                        Else
                            wsA.Cells(r, commentsCol).Value = "Review Required"
                            If Not cumulWB Is Nothing And cumulIdCol > 0 Then
                                ' --- Append full row to cumulative Excel ---
                                Dim cumulLastRow As Long
                                cumulLastRow = LastUsedRow(cumulWS)
                                cumulWS.Rows(cumulLastRow + 1).Insert Shift:=xlDown
                                wsA.Rows(r).Copy cumulWS.Rows(cumulLastRow + 1)
                                cumulChanged = True
                                cumulIdDict(LCase$(eventId)) = True
                                ' --- Append full row to Generate sheet ---
                                wsA.Rows(r).Copy genWS.Rows(genNextRow)
                                genNextRow = genNextRow + 1
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next r
    '=======================
    ' Apply borders to new Generate rows
    '=======================
    If genNextRow > 15 Then
        With genWS.Range(genWS.Cells(15, 1), genWS.Cells(genNextRow - 1, 500)).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End If
    ' Save cumulative workbook if changed
    If cumulChanged And Not cumulWB Is Nothing Then cumulWB.Save
SaveAndFinish:
    '=======================
    ' Save consolidated file with auto-counter
    '=======================
    Dim effSaveDate As Date: effSaveDate = EffectiveDateByShift()
    Dim saveFolder As String: saveFolder = Trim$(GetSettingsPathOrPrompt(ThisWorkbook, "Generate", "B3"))
    If Len(saveFolder) = 0 Then
        MsgBox "No folder selected. Operation cancelled.", vbExclamation
        GoTo CleanFail
    End If
    If Right$(saveFolder, 1) = "\" Then saveFolder = Left$(saveFolder, Len(saveFolder) - 1)
    Dim baseName As String, finalName As String, counter As Long
    baseName = saveFolder & "\" & "Open Redress Pipeline Monitor " & Format$(effSaveDate, "mm.dd.yyyy") & ".xlsx"
    finalName = baseName
    counter = 1
    Do While Dir(finalName) <> ""
        finalName = saveFolder & "\" & "Open Redress Pipeline Monitor " & _
                    Format$(effSaveDate, "mm.dd.yyyy") & " (" & counter & ").xlsx"
        counter = counter + 1
    Loop
    wbA.SaveAs Filename:=finalName, FileFormat:=xlOpenXMLWorkbook
AfterProcessing:
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Process completed successfully!", vbInformation
    Exit Sub
CleanFail:
    On Error Resume Next
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Operation cancelled or failed.", vbExclamation
End Sub
'========================
' NEW Helper: Remove "Total" footer row (last row with "Total" in Col A)
' Handles merged A:DD or unmerged, and deletes entire row regardless of other columns.
'========================
Private Sub RemoveLastTotalRow(ByVal ws As Worksheet)
    Dim lr As Long, valA As String, cellA As Range, topLeft As Range
    lr = LastUsedRow(ws)
    If lr < 2 Then Exit Sub ' nothing to do
    Set cellA = ws.Cells(lr, 1)
    ' If merged, Excel stores the text in the top-left cell of MergeArea (usually A:…)
    If cellA.MergeCells Then
        Set topLeft = cellA.MergeArea.Cells(1, 1)
    Else
        Set topLeft = cellA
    End If
    valA = NormalizeHeader(CStr(topLeft.Value))
    If valA = "total" Then
        ws.Rows(lr).Delete
    End If
End Sub
'========================
' Helper: Case-insensitive, space-tolerant header finder
'========================
Public Function FindHeaderCol(ws As Worksheet, headerName As String) As Long
    Dim target As String, cellText As String
    Dim lastCol As Long, c As Long, headerRow As Long
    headerRow = 1
    target = NormalizeHeader(headerName)
    ' Get last filled column on header row (with fallback)
    lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column
    If lastCol < 1 Then
        On Error Resume Next
        lastCol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
        On Error GoTo 0
        If lastCol < 1 Then lastCol = 200
    End If
    For c = 1 To lastCol
        cellText = NormalizeHeader(CStr(ws.Cells(headerRow, c).Value))
        If cellText = target Then
            FindHeaderCol = c
            Exit Function
        End If
    Next c
    FindHeaderCol = 0
End Function
'========================
' Helper: Normalize header text (clean/trim/collapse/lower)
'========================
Private Function NormalizeHeader(ByVal s As String) As String
    Dim t As String
    t = CStr(s)
    ' Clean nonprintables and unify whitespace kinds
    On Error Resume Next
    t = Application.WorksheetFunction.Clean(t)
    On Error GoTo 0
    t = Replace(t, Chr(160), " ")
    t = Replace(t, vbCrLf, " ")
    t = Replace(t, vbCr, " ")
    t = Replace(t, vbLf, " ")
    t = Replace(t, vbTab, " ")
    ' Collapse multiple spaces
    Do While InStr(t, "  ") > 0
        t = Replace(t, "  ", " ")
    Loop
    NormalizeHeader = LCase$(Trim$(t))
End Function
'========================
' Robust last used ROW
'========================
Public Function LastUsedRow(ws As Worksheet) As Long
    Dim f As Range
    On Error Resume Next
    Set f = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, _
                          SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    On Error GoTo 0
    If f Is Nothing Then
        LastUsedRow = 0
    Else
        LastUsedRow = f.Row
    End If
End Function
'========================
' Robust last used COLUMN (prefers header row, with fallback)
'========================
Public Function LastUsedCol(ws As Worksheet) As Long
    Dim lc As Long
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    If lc = 1 And Len(CStr(ws.Cells(1, 1).Value)) = 0 Then
        Dim f As Range
        On Error Resume Next
        Set f = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, _
                              SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
        On Error GoTo 0
        If f Is Nothing Then
            lc = 0
        Else
            lc = f.Column
        End If
    End If
    LastUsedCol = lc
End Function
'========================
' NEW Helper: allow selecting one or two files (xlsx/csv)
'========================
Private Function PickOneOrTwoFiles(ByRef fileA As String, ByRef fileB As String) As Boolean
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Title = "Select one or two Event Research files"
        .Filters.Clear
        .Filters.Add "Excel (*.xlsx;*.csv)", "*.xlsx;*.csv"
        If .Show <> -1 Then Exit Function
        If .SelectedItems.Count = 0 Then Exit Function
        fileA = .SelectedItems(1)
        If .SelectedItems.Count >= 2 Then
            fileB = .SelectedItems(2)
        Else
            fileB = ""
        End If
        PickOneOrTwoFiles = True
    End With
End Function