Attribute VB_Name = "ModelAuditTool"
'==================================================================
' MODEL AUDIT TOOL
' Version: v2.1
'==================================================================
' Scans the active workbook for common financial-model risks and
' writes a findings report, with a summary dashboard, severity
' color-coding, and click-to-navigate hyperlinks, to a new sheet
' called "Audit_Report".
'
' Also provides a Save Baseline / Compare-to-Baseline pair that
' snapshots every non-empty cell's formula+value to a hidden sheet
' ("Audit_Baseline", xlSheetVeryHidden) and later diffs the model
' against it, writing changes to "Baseline_Diff".
'
' HOW TO INSTALL:
'   1. Open your model in Excel (Windows or Mac).
'   2. Press Alt+F11 (Windows) or Opt+F11 (Mac) to open the VBA editor.
'   3. If you previously imported an older version of this module,
'      right-click it in the Project pane and Remove it first.
'   4. File > Import File... and select this .bas file.
'   5. Close the VBA editor.
'   6. Press Alt+F8 and run one of:
'        - RunModelAudit          (audit the workbook)
'        - SaveBaseline           (snapshot formulas + values)
'        - CompareToBaseline      (diff current vs. snapshot)
'        - ClearBaseline          (delete the hidden snapshot)
'
' WHAT THE AUDIT CHECKS:
'   1.  Hardcoded numbers embedded inside formulas.                [Warning]
'   2.  Static values in a row where both neighbors are formulas.  [Warning]
'   3.  Error cells (#REF!, #DIV/0!, #N/A, #VALUE!, #NAME?, #NUM!).[Critical]
'   4.  Formulas that reference other external workbooks.          [Critical]
'   5.  Number format that doesn't match matching row neighbors.   [Warning]
'   6.  Formula pattern that breaks from row neighbors.            [Warning]
'   7.  Formula pattern that breaks from column neighbors.         [Warning]
'   8.  Volatile functions (OFFSET, INDIRECT, NOW, TODAY, RAND...).[Warning]
'   9.  Merged cells (hostile to sorting/copying and audits).      [Warning]
'  10.  Circular references (per sheet).                           [Critical]
'  11.  Hidden rows / columns.                                     [Warning]
'  12.  Hidden vs. very-hidden worksheets (distinct severities).   [Warning/Crit]
'
' SUPPRESSING FALSE POSITIVES:
'   Create a sheet named "Audit_Config". In column A list issue-type
'   names to suppress globally, or use "SheetName!A1:B10" style
'   entries (with optional "|IssueType" suffix) to suppress specific
'   cells. Wildcards * and ? are supported.  Example rows in col A:
'       Hardcoded number in formula
'       Inputs!*|Hardcoded number in formula
'       Assumptions!B5:B99
'   Optionally, put an override trivial-numbers list in cell B1 of
'   Audit_Config, e.g. "0,1,2,4,10,12,52,100,365,1000".
'
' COMPATIBILITY: Windows Excel + Mac Excel. No Scripting.Dictionary,
'   no other Windows-only late-bound COM objects.
'==================================================================

Option Explicit

' --- Layout constants for the report sheet -----------------------
Private Const REPORT_SHEET      As String = "Audit_Report"
Private Const BASELINE_SHEET    As String = "Audit_Baseline"
Private Const DIFF_SHEET        As String = "Baseline_Diff"
Private Const CONFIG_SHEET      As String = "Audit_Config"
Private Const HEADER_ROW        As Long = 18
Private Const DATA_START_ROW    As Long = 19

' --- Default trivial-numbers list (override via Audit_Config!B1) --
Private Const DEFAULT_TRIVIAL   As String = "0,1,2,4,10,12,52,100,365,1000"

' --- Baseline compare tolerance for value drift (absolute) --------
Private Const VALUE_TOLERANCE   As Double = 0.000001

' --- Module-level state ------------------------------------------
Private mIssueCounts   As Collection   ' key -> count (issue type)
Private mIssueKeys     As Collection   ' insertion-ordered keys
Private mCriticalCount As Long
Private mWarningCount  As Long
Private mSuppressed    As Long
Private mTrivialList   As String
Private mSkipRules     As Collection   ' whitelist entries (strings)

'==================================================================
' MAIN ENTRY POINT
'==================================================================
Sub RunModelAudit()

    Dim wsReport As Worksheet, ws As Worksheet
    Dim reportRow As Long
    Dim savedCalc As XlCalculation
    Dim savedScreen As Boolean, savedEvents As Boolean, savedStatus As Variant
    Dim tStart As Double
    Dim sheetIdx As Long, sheetTotal As Long

    On Error GoTo Fatal
    tStart = Timer

    ' Preserve caller's app state so we can restore no matter what
    savedCalc = Application.Calculation
    savedScreen = Application.ScreenUpdating
    savedEvents = Application.EnableEvents
    savedStatus = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Model Audit: initializing..."

    InitState

    ' --- Fresh report sheet ---
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(REPORT_SHEET).Delete
    On Error GoTo Fatal
    Application.DisplayAlerts = True

    Set wsReport = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
    wsReport.Name = REPORT_SHEET
    BuildReportHeader wsReport
    reportRow = DATA_START_ROW

    sheetTotal = ThisWorkbook.Worksheets.Count
    sheetIdx = 0

    For Each ws In ThisWorkbook.Worksheets
        sheetIdx = sheetIdx + 1
        Application.StatusBar = "Model Audit: scanning '" & ws.Name & _
            "' (" & sheetIdx & "/" & sheetTotal & ")..."

        If ws.Name <> REPORT_SHEET And ws.Name <> BASELINE_SHEET _
            And ws.Name <> DIFF_SHEET And ws.Name <> CONFIG_SHEET Then
            ScanSheet ws, wsReport, reportRow
        End If
    Next ws

    Application.StatusBar = "Model Audit: checking named ranges..."
    CheckNamedRanges wsReport, reportRow

    WriteSummary wsReport, reportRow, tStart

    ' Restore app state
    Application.Calculation = savedCalc
    Application.EnableEvents = savedEvents
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False

    wsReport.Activate
    wsReport.Range("A1").Select

    MsgBox "Audit complete in " & Format(Timer - tStart, "0.0") & "s." & vbNewLine & _
           "Critical: " & mCriticalCount & "   Warnings: " & mWarningCount & _
           "   Suppressed: " & mSuppressed & vbNewLine & _
           "See '" & REPORT_SHEET & "' for details.", vbInformation
    Exit Sub

Fatal:
    Application.Calculation = savedCalc
    Application.EnableEvents = savedEvents
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False
    Application.DisplayAlerts = True
    MsgBox "Audit stopped due to an unexpected error:" & vbNewLine & _
           "  " & Err.Number & " - " & Err.Description, vbExclamation
End Sub

'==================================================================
' Per-sheet scan.  Reads formulas + values in bulk (fast) and only
' falls back to per-cell iteration for property checks that don't
' round-trip through Variant arrays (NumberFormat, MergeCells,
' Hidden, CircularReference).
'==================================================================
Private Sub ScanSheet(ws As Worksheet, wsReport As Worksheet, ByRef reportRow As Long)

    Dim usedRng As Range
    Dim fArr As Variant, vArr As Variant
    Dim rows As Long, cols As Long
    Dim r As Long, c As Long
    Dim firstRow As Long, firstCol As Long
    Dim addr As String, fx As String, vx As Variant
    Dim r1c1 As String, leftFR As String, rightFR As String, upFR As String, downFR As String

    ' Hidden / very-hidden worksheet gets flagged once per sheet
    If ws.Visible = xlSheetVeryHidden Then
        AddFinding wsReport, reportRow, ws.Name, "$A$1", _
            "Very-hidden worksheet", _
            "Sheet is xlSheetVeryHidden - only reachable via VBA. Confirm intentional.", _
            "", "Critical"
    ElseIf ws.Visible = xlSheetHidden Then
        AddFinding wsReport, reportRow, ws.Name, "$A$1", _
            "Hidden worksheet", _
            "Sheet is hidden. Confirm it isn't hiding stale data or assumptions.", _
            "", "Warning"
    End If

    ' Circular reference (Excel exposes the first cell involved)
    Dim circCell As Range
    Set circCell = Nothing
    On Error Resume Next
    Set circCell = ws.CircularReference
    On Error GoTo 0
    If Not circCell Is Nothing Then
        AddFinding wsReport, reportRow, ws.Name, circCell.Address(False, False), _
            "Circular reference", _
            "Sheet contains a circular reference chain starting here.", _
            circCell.Formula, "Critical"
    End If

    On Error Resume Next
    Set usedRng = ws.UsedRange
    On Error GoTo 0
    If usedRng Is Nothing Then Exit Sub

    firstRow = usedRng.Row
    firstCol = usedRng.Column
    rows = usedRng.Rows.Count
    cols = usedRng.Columns.Count

    ' Bulk pull.  Wrap single-cell case (returns scalar, not array).
    If rows = 1 And cols = 1 Then
        ReDim fArr(1 To 1, 1 To 1): fArr(1, 1) = usedRng.Formula
        ReDim vArr(1 To 1, 1 To 1): vArr(1, 1) = usedRng.Value
    Else
        fArr = usedRng.Formula
        vArr = usedRng.Value
    End If

    ' ---- Fast per-cell pass over the arrays ----
    For r = 1 To rows
        ' progress ping every ~500 rows to avoid StatusBar churn
        If (r Mod 500) = 0 Then
            Application.StatusBar = "Model Audit: '" & ws.Name & "' row " & r & "/" & rows
            DoEvents
        End If
        For c = 1 To cols
            If IsError(fArr(r, c)) Then
                fx = ""
            Else
                fx = CStr(fArr(r, c))
            End If
            vx = vArr(r, c)
            If Len(fx) = 0 And IsEmpty(vx) Then GoTo NextCell
            addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address(False, False)

            ' Check 3: error values (works on the value, formula or not)
            If IsError(vx) Then
                Dim errStr As String
                errStr = ErrText(vx)
                AddFinding wsReport, reportRow, ws.Name, addr, _
                    "Error value", "Cell evaluates to an error.", _
                    errStr, "Critical"
            End If

            If Len(fx) > 0 And Left$(fx, 1) = "=" Then
                ' Check 1: hardcoded number in formula
                CheckHardcodedNumber ws, wsReport, reportRow, addr, fx

                ' Check 4: external workbook link
                If InStr(fx, "[") > 0 And InStr(fx, "]") > 0 Then
                    AddFinding wsReport, reportRow, ws.Name, addr, _
                        "External workbook link", _
                        "Formula references another workbook - fragile if that file moves.", _
                        fx, "Critical"
                End If

                ' Check 8: volatile functions
                CheckVolatile ws, wsReport, reportRow, addr, fx
            End If
NextCell:
        Next c
    Next r

    ' ---- Neighbor-based checks (row + column consistency) ----
    ' These need R1C1 formulas, easier to walk the range object directly
    ' but still driven off the arrays we already have.
    Dim leftF As String, rightF As String, upF As String, downF As String
    Dim thisF As String, thisV As Variant
    For r = 1 To rows
        For c = 2 To cols - 1
            thisF = SafeCStr(fArr(r, c))
            thisV = vArr(r, c)
            leftF = SafeCStr(fArr(r, c - 1))
            rightF = SafeCStr(fArr(r, c + 1))

            ' Check 2: static number sandwiched between two formulas
            If Len(thisF) = 0 Or Left$(thisF, 1) <> "=" Then
                If IsNumeric(thisV) And Not IsEmpty(thisV) Then
                    If Left$(leftF, 1) = "=" And Left$(rightF, 1) = "=" Then
                        addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address(False, False)
                        AddFinding wsReport, reportRow, ws.Name, addr, _
                            "Static value in formula row", _
                            "Hardcoded number but both row neighbors are formulas - possible overwritten formula.", _
                            CStr(thisV), "Warning"
                    End If
                End If
            End If

            ' Check 6: formula pattern breaks from row neighbors
            If Left$(thisF, 1) = "=" And Left$(leftF, 1) = "=" And Left$(rightF, 1) = "=" Then
                leftFR = ws.Cells(firstRow + r - 1, firstCol + c - 2).FormulaR1C1
                rightFR = ws.Cells(firstRow + r - 1, firstCol + c).FormulaR1C1
                r1c1 = ws.Cells(firstRow + r - 1, firstCol + c - 1).FormulaR1C1
                If leftFR = rightFR And r1c1 <> leftFR Then
                    addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address(False, False)
                    AddFinding wsReport, reportRow, ws.Name, addr, _
                        "Inconsistent formula (row)", _
                        "Formula pattern differs from row neighbors, which match each other - copy-paste error?", _
                        thisF, "Warning"
                End If
            End If
        Next c
    Next r

    ' Check 7: formula pattern breaks from COLUMN neighbors
    For c = 1 To cols
        For r = 2 To rows - 1
            thisF = SafeCStr(fArr(r, c))
            upF = SafeCStr(fArr(r - 1, c))
            downF = SafeCStr(fArr(r + 1, c))
            If Left$(thisF, 1) = "=" And Left$(upF, 1) = "=" And Left$(downF, 1) = "=" Then
                upFR = ws.Cells(firstRow + r - 2, firstCol + c - 1).FormulaR1C1
                downFR = ws.Cells(firstRow + r, firstCol + c - 1).FormulaR1C1
                r1c1 = ws.Cells(firstRow + r - 1, firstCol + c - 1).FormulaR1C1
                If upFR = downFR And r1c1 <> upFR Then
                    addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address(False, False)
                    AddFinding wsReport, reportRow, ws.Name, addr, _
                        "Inconsistent formula (column)", _
                        "Formula pattern differs from column neighbors, which match each other - copy-paste error?", _
                        thisF, "Warning"
                End If
            End If
        Next r
    Next c

    ' ---- Per-cell property checks (format, merges) ----
    Application.StatusBar = "Model Audit: '" & ws.Name & "' format / merge scan..."
    Dim cell As Range
    For Each cell In usedRng.Cells
        If cell.MergeCells Then
            If cell.Address = cell.MergeArea.Cells(1, 1).Address Then
                AddFinding wsReport, reportRow, ws.Name, cell.Address(False, False), _
                    "Merged cells", _
                    "Range " & cell.MergeArea.Address(False, False) & " is merged - hostile to sorting, copying and audits.", _
                    "", "Warning"
            End If
        End If
        If IsNumeric(cell.Value) And Not IsEmpty(cell.Value) Then
            CheckFormatConsistency cell, ws, wsReport, reportRow
        End If
    Next cell

    ' ---- Hidden rows / columns within used range ----
    Dim rr As Range, cc As Range
    For Each rr In usedRng.Rows
        If rr.EntireRow.Hidden Then
            AddFinding wsReport, reportRow, ws.Name, "A" & rr.Row, _
                "Hidden row", _
                "Row " & rr.Row & " is hidden - confirm it isn't hiding stale data.", _
                "", "Warning"
        End If
    Next rr
    For Each cc In usedRng.Columns
        If cc.EntireColumn.Hidden Then
            AddFinding wsReport, reportRow, ws.Name, ColLetter(cc.Column) & "1", _
                "Hidden column", _
                "Column " & ColLetter(cc.Column) & " is hidden - confirm it isn't hiding stale data.", _
                "", "Warning"
        End If
    Next cc
End Sub

'==================================================================
' NAMED-RANGE HYGIENE (v2.1)
'   - Dangling #REF! names
'   - Workbook-scope vs. sheet-scope name collisions
'   - Names hidden (Visible = False)
'   - Names whose RefersTo doesn't resolve to a real Range
'==================================================================
Private Sub CheckNamedRanges(wsReport As Worksheet, ByRef reportRow As Long)

    Dim nm As Name, ws As Worksheet
    Dim refStr As String
    Dim wbNames As Collection, localNames As Collection
    Dim i As Long, key As String

    Set wbNames = New Collection

    ' --- Pass 1: workbook-scope names ---
    For Each nm In ThisWorkbook.Names
        ' Skip Excel internal names (start with _xlnm, _FilterDatabase, Print_Area, etc.)
        If Not IsInternalName(nm.Name) Then
            refStr = ""
            On Error Resume Next
            refStr = nm.RefersTo
            On Error GoTo 0

            ' Dangling #REF!
            If InStr(refStr, "#REF!") > 0 Then
                AddFinding wsReport, reportRow, "(Workbook)", "'" & nm.Name, _
                    "Dangling named range", _
                    "Workbook-scope name '" & nm.Name & "' refers to #REF! - target was deleted.", _
                    refStr, "Critical"
            End If

            ' RefersTo doesn't resolve to a real Range
            Dim tstRng As Range: Set tstRng = Nothing
            On Error Resume Next
            Set tstRng = nm.RefersToRange
            On Error GoTo 0
            If tstRng Is Nothing And InStr(refStr, "#REF!") = 0 _
                And Left$(refStr, 1) = "=" Then
                ' Skip pure-formula names (RefersTo = "=SUM(...)"), those don't resolve to Range.
                If Not LooksLikeFormulaName(refStr) Then
                    AddFinding wsReport, reportRow, "(Workbook)", "'" & nm.Name, _
                        "Unresolvable named range", _
                        "Workbook-scope name '" & nm.Name & "' does not resolve to a range.", _
                        refStr, "Warning"
                End If
            End If

            ' Hidden name
            If nm.Visible = False Then
                AddFinding wsReport, reportRow, "(Workbook)", "'" & nm.Name, _
                    "Hidden named range", _
                    "Workbook-scope name '" & nm.Name & "' is hidden (Visible=False) - confirm intentional.", _
                    refStr, "Warning"
            End If

            ' Remember for collision check
            On Error Resume Next
            wbNames.Add nm.Name, LCase$(nm.Name)
            On Error GoTo 0
        End If
    Next nm

    ' --- Pass 2: sheet-scope names + collision detection ---
    For Each ws In ThisWorkbook.Worksheets
        For Each nm In ws.Names
            Dim shortName As String
            shortName = LocalNameOnly(nm.Name)
            If Not IsInternalName(shortName) Then
                refStr = ""
                On Error Resume Next
                refStr = nm.RefersTo
                On Error GoTo 0

                If InStr(refStr, "#REF!") > 0 Then
                    AddFinding wsReport, reportRow, ws.Name, "'" & shortName, _
                        "Dangling named range", _
                        "Sheet-scope name '" & shortName & "' refers to #REF! - target was deleted.", _
                        refStr, "Critical"
                End If

                If nm.Visible = False Then
                    AddFinding wsReport, reportRow, ws.Name, "'" & shortName, _
                        "Hidden named range", _
                        "Sheet-scope name '" & shortName & "' is hidden (Visible=False) - confirm intentional.", _
                        refStr, "Warning"
                End If

                ' Collision with a workbook-scope name of the same short name
                Dim collides As Boolean: collides = False
                Dim probe As String: probe = ""
                On Error Resume Next
                probe = wbNames(LCase$(shortName))
                If Err.Number = 0 And Len(probe) > 0 Then collides = True
                Err.Clear
                On Error GoTo 0
                If collides Then
                    AddFinding wsReport, reportRow, ws.Name, "'" & shortName, _
                        "Name scope collision", _
                        "Sheet-scope name '" & shortName & "' shadows a workbook-scope name with the same name - which one wins depends on the calling sheet.", _
                        refStr, "Warning"
                End If
            End If
        Next nm
    Next ws
End Sub

' _xlnm.Print_Area, _xlnm._FilterDatabase, _xlfn.*, etc. are Excel-managed.
Private Function IsInternalName(nm As String) As Boolean
    Dim u As String: u = UCase$(nm)
    If Left$(u, 6) = "_XLNM." Or Left$(u, 6) = "_XLFN." _
        Or InStr(u, "!_XLNM.") > 0 Or InStr(u, "!_XLFN.") > 0 Then
        IsInternalName = True
    End If
End Function

' "Sheet1!MyName" -> "MyName"; "MyName" -> "MyName"
Private Function LocalNameOnly(nm As String) As String
    Dim bang As Long: bang = InStrRev(nm, "!")
    If bang > 0 Then
        LocalNameOnly = Mid$(nm, bang + 1)
    Else
        LocalNameOnly = nm
    End If
End Function

' RefersTo like "=SUM(A1:A10)*2" is a formula-name, not a range-name.
' Heuristic: contains an operator or a function-open-paren but no plain
' cell/sheet reference at the top level.  We only use this to *suppress*
' the "unresolvable" warning for legitimate formula names.
Private Function LooksLikeFormulaName(refStr As String) As Boolean
    Dim s As String: s = refStr
    If Left$(s, 1) = "=" Then s = Mid$(s, 2)
    ' If there's a function call followed by something other than a pure
    ' range, or an arithmetic operator, treat as formula.
    If InStr(s, "+") > 0 Or InStr(s, "-") > 0 Or InStr(s, "*") > 0 _
        Or InStr(s, "/") > 0 Or InStr(s, "^") > 0 Then
        LooksLikeFormulaName = True
        Exit Function
    End If
    ' Bare function call like SUM(A1:A10)
    If InStr(s, "(") > 0 Then
        LooksLikeFormulaName = True
    End If
End Function


'==================================================================
' CHECK IMPLEMENTATIONS (individual analyzers)
'==================================================================

Private Sub CheckHardcodedNumber(ws As Worksheet, wsReport As Worksheet, _
    ByRef reportRow As Long, addr As String, f As String)

    Dim i As Long, c As String, prev As String
    Dim inNumber As Boolean, numStr As String

    inNumber = False
    numStr = ""
    For i = 2 To Len(f)
        c = Mid$(f, i, 1)
        prev = Mid$(f, i - 1, 1)
        If c Like "[0-9]" And Not (prev Like "[A-Za-z0-9_$]") Then
            inNumber = True
            numStr = c
        ElseIf inNumber And c Like "[0-9]" Then
            numStr = numStr & c
        ElseIf inNumber And (c = "." Or c = "%") Then
            numStr = numStr & c
        Else
            If inNumber Then
                FlagIfNontrivial ws, wsReport, reportRow, addr, f, numStr
            End If
            inNumber = False
            numStr = ""
        End If
    Next i
    If inNumber Then FlagIfNontrivial ws, wsReport, reportRow, addr, f, numStr
End Sub

Private Sub FlagIfNontrivial(ws As Worksheet, wsReport As Worksheet, _
    ByRef reportRow As Long, addr As String, f As String, numStr As String)
    If Len(numStr) = 0 Then Exit Sub
    If IsTrivialNumber(numStr) Then Exit Sub
    AddFinding wsReport, reportRow, ws.Name, addr, _
        "Hardcoded number in formula", _
        "Literal '" & numStr & "' embedded in formula - consider a labeled input cell.", _
        f, "Warning"
End Sub

Private Function IsTrivialNumber(numStr As String) As Boolean
    Dim parts() As String, i As Long
    parts = Split(mTrivialList, ",")
    For i = LBound(parts) To UBound(parts)
        If numStr = Trim$(parts(i)) Then
            IsTrivialNumber = True
            Exit Function
        End If
    Next i
End Function

Private Sub CheckVolatile(ws As Worksheet, wsReport As Worksheet, _
    ByRef reportRow As Long, addr As String, f As String)
    Dim uf As String
    uf = UCase$(f)
    Dim hit As String
    hit = FirstMatch(uf, Array("OFFSET(", "INDIRECT(", "NOW(", "TODAY(", _
                                "RAND(", "RANDBETWEEN(", "INFO(", "RANDARRAY("))
    If Len(hit) > 0 Then
        AddFinding wsReport, reportRow, ws.Name, addr, _
            "Volatile function", _
            "Formula uses volatile function " & Replace(hit, "(", "") & _
            " - forces recalculation on every change and can hurt performance / auditability.", _
            f, "Warning"
    End If
End Sub

Private Function FirstMatch(hay As String, needles As Variant) As String
    Dim i As Long
    For i = LBound(needles) To UBound(needles)
        If InStr(hay, needles(i)) > 0 Then
            FirstMatch = needles(i)
            Exit Function
        End If
    Next i
End Function

Private Sub CheckFormatConsistency(cell As Range, ws As Worksheet, _
    wsReport As Worksheet, ByRef reportRow As Long)

    Dim leftCell As Range, rightCell As Range
    If cell.Column <= 1 Then Exit Sub
    If cell.Value = 0 And Not cell.HasFormula Then Exit Sub

    On Error Resume Next
    Set leftCell = cell.Offset(0, -1)
    Set rightCell = cell.Offset(0, 1)
    On Error GoTo 0
    If leftCell Is Nothing Or rightCell Is Nothing Then Exit Sub
    If Not IsNumeric(leftCell.Value) Or Not IsNumeric(rightCell.Value) Then Exit Sub
    If leftCell.Value = 0 Or rightCell.Value = 0 Then Exit Sub

    If leftCell.NumberFormat = rightCell.NumberFormat And _
       cell.NumberFormat <> leftCell.NumberFormat Then
        AddFinding wsReport, reportRow, ws.Name, cell.Address(False, False), _
            "Inconsistent number format", _
            "Format '" & cell.NumberFormat & "' differs from row neighbors ('" & _
            leftCell.NumberFormat & "').", CStr(cell.Value), "Warning"
    End If
End Sub

'==================================================================
' REPORT WRITER (with click-to-navigate hyperlinks + suppression)
'==================================================================
Private Sub AddFinding(wsReport As Worksheet, ByRef reportRow As Long, _
    sheetName As String, cellAddr As String, issueType As String, _
    details As String, formulaOrValue As String, severity As String)

    If IsSuppressed(sheetName, cellAddr, issueType) Then
        mSuppressed = mSuppressed + 1
        Exit Sub
    End If

    wsReport.Cells(reportRow, 1).Value = sheetName
    wsReport.Cells(reportRow, 2).Value = cellAddr
    wsReport.Cells(reportRow, 3).Value = issueType
    wsReport.Cells(reportRow, 4).Value = details
    ' Prefix with apostrophe so long formulas render as text, not eval'd
    wsReport.Cells(reportRow, 5).Value = "'" & formulaOrValue
    wsReport.Cells(reportRow, 6).Value = severity

    ' Click-to-navigate hyperlink on the Cell column
    On Error Resume Next
    wsReport.Hyperlinks.Add _
        Anchor:=wsReport.Cells(reportRow, 2), _
        Address:="", _
        SubAddress:="'" & sheetName & "'!" & cellAddr, _
        TextToDisplay:=cellAddr
    On Error GoTo 0

    Select Case severity
        Case "Critical"
            wsReport.Range("A" & reportRow & ":F" & reportRow).Interior.Color = RGB(255, 199, 206)
            mCriticalCount = mCriticalCount + 1
        Case "Warning"
            wsReport.Range("A" & reportRow & ":F" & reportRow).Interior.Color = RGB(255, 235, 156)
            mWarningCount = mWarningCount + 1
    End Select

    IncrementCounter issueType
    reportRow = reportRow + 1
End Sub

Private Sub IncrementCounter(key As String)
    Dim cur As Long
    On Error Resume Next
    cur = 0
    cur = mIssueCounts(key)
    On Error GoTo 0
    If cur = 0 Then
        mIssueCounts.Add 1, key
        mIssueKeys.Add key
    Else
        mIssueCounts.Remove key
        mIssueCounts.Add cur + 1, key
    End If
End Sub

Private Sub BuildReportHeader(wsReport As Worksheet)
    wsReport.Range("A" & HEADER_ROW & ":F" & HEADER_ROW).Value = _
        Array("Sheet", "Cell", "Issue Type", "Details", "Formula / Value", "Severity")
    wsReport.Range("A" & HEADER_ROW & ":F" & HEADER_ROW).Font.Bold = True
    wsReport.Range("A" & HEADER_ROW & ":F" & HEADER_ROW).Interior.Color = RGB(217, 217, 217)
    wsReport.Columns("A:C").ColumnWidth = 20
    wsReport.Columns("D").ColumnWidth = 55
    wsReport.Columns("E").ColumnWidth = 32
    wsReport.Columns("F").ColumnWidth = 12
End Sub

Private Sub WriteSummary(wsReport As Worksheet, reportRow As Long, tStart As Double)
    Dim sRow As Long, i As Long, k As String

    wsReport.Range("A1").Value = "MODEL AUDIT SUMMARY"
    wsReport.Range("A1").Font.Bold = True
    wsReport.Range("A1").Font.Size = 14

    wsReport.Range("A2").Value = "Total issues flagged: " & (mCriticalCount + mWarningCount) & _
        "   (Suppressed by Audit_Config: " & mSuppressed & ")"
    wsReport.Range("A2").Font.Bold = True

    wsReport.Range("A3").Value = "Critical: " & mCriticalCount
    wsReport.Range("A3").Font.Color = RGB(156, 0, 6)
    wsReport.Range("A3").Font.Bold = True
    wsReport.Range("B3").Value = "Warnings: " & mWarningCount
    wsReport.Range("B3").Font.Color = RGB(156, 101, 0)
    wsReport.Range("B3").Font.Bold = True
    wsReport.Range("C3").Value = "Scanned in " & Format(Timer - tStart, "0.0") & "s"

    wsReport.Range("A4").Value = "Breakdown by issue type:"
    wsReport.Range("A4").Font.Italic = True
    sRow = 5
    For i = 1 To mIssueKeys.Count
        k = mIssueKeys(i)
        wsReport.Cells(sRow, 1).Value = k & ": " & mIssueCounts(k)
        sRow = sRow + 1
        If sRow > HEADER_ROW - 1 Then Exit For
    Next i

    If reportRow = DATA_START_ROW Then
        wsReport.Range("A" & DATA_START_ROW).Value = "No issues found."
    Else
        wsReport.Range("A" & HEADER_ROW & ":F" & (reportRow - 1)).AutoFilter
    End If
    wsReport.Columns("A:F").HorizontalAlignment = xlLeft
End Sub

'==================================================================
' STATE INIT + CONFIG SHEET PARSING (whitelist + trivial override)
'==================================================================
Private Sub InitState()
    Set mIssueCounts = New Collection
    Set mIssueKeys = New Collection
    Set mSkipRules = New Collection
    mCriticalCount = 0
    mWarningCount = 0
    mSuppressed = 0
    mTrivialList = DEFAULT_TRIVIAL

    Dim cfg As Worksheet
    On Error Resume Next
    Set cfg = ThisWorkbook.Worksheets(CONFIG_SHEET)
    On Error GoTo 0
    If cfg Is Nothing Then Exit Sub

    Dim override As String
    override = Trim$(CStr(cfg.Range("B1").Value))
    If Len(override) > 0 Then mTrivialList = override

    Dim lastRow As Long, i As Long, rule As String
    lastRow = cfg.Cells(cfg.Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastRow
        rule = Trim$(CStr(cfg.Cells(i, 1).Value))
        If Len(rule) > 0 Then mSkipRules.Add rule
    Next i
End Sub

Private Function IsSuppressed(sheetName As String, cellAddr As String, _
    issueType As String) As Boolean

    If mSkipRules Is Nothing Then Exit Function
    If mSkipRules.Count = 0 Then Exit Function

    Dim i As Long, rule As String, rulePart As String, typePart As String
    Dim bar As Long
    For i = 1 To mSkipRules.Count
        rule = mSkipRules(i)
        bar = InStr(rule, "|")
        If bar > 0 Then
            rulePart = Left$(rule, bar - 1)
            typePart = Mid$(rule, bar + 1)
        Else
            rulePart = rule
            typePart = ""
        End If

        ' Case A: pure issue-type suppression (no sheet prefix, no ! )
        If InStr(rulePart, "!") = 0 And Len(typePart) = 0 Then
            If issueType Like rulePart Then
                IsSuppressed = True: Exit Function
            End If
        Else
            ' Case B: "Sheet!Range" [|IssueType]
            If Len(typePart) > 0 Then
                If Not (issueType Like typePart) Then GoTo NextRule
            End If
            If SheetCellMatches(rulePart, sheetName, cellAddr) Then
                IsSuppressed = True: Exit Function
            End If
        End If
NextRule:
    Next i
End Function

Private Function SheetCellMatches(rulePart As String, sheetName As String, _
    cellAddr As String) As Boolean

    Dim bang As Long, sn As String, rangePart As String
    bang = InStr(rulePart, "!")
    If bang = 0 Then Exit Function
    sn = Left$(rulePart, bang - 1)
    rangePart = Mid$(rulePart, bang + 1)
    If Not (sheetName Like sn) Then Exit Function

    ' If the rule looks like a real range, do an intersect check.
    On Error Resume Next
    Dim ruleRng As Range, cellRng As Range
    Set ruleRng = ThisWorkbook.Worksheets(sheetName).Range(rangePart)
    Set cellRng = ThisWorkbook.Worksheets(sheetName).Range(cellAddr)
    On Error GoTo 0
    If Not ruleRng Is Nothing And Not cellRng Is Nothing Then
        If Not Application.Intersect(ruleRng, cellRng) Is Nothing Then
            SheetCellMatches = True
            Exit Function
        End If
    End If

    ' Fallback: literal Like match (supports wildcards like B*)
    If cellAddr Like rangePart Then SheetCellMatches = True
End Function

'==================================================================
' UTILITIES
'==================================================================
Private Function ColLetter(colNum As Long) As String
    Dim n As Long, s As String
    n = colNum
    Do While n > 0
        s = Chr$(65 + ((n - 1) Mod 26)) & s
        n = (n - 1) \ 26
    Loop
    ColLetter = s
End Function

' CStr() that never blows up on Error/Null variants.
Private Function SafeCStr(v As Variant) As String
    If IsError(v) Then
        SafeCStr = ErrText(v)
    ElseIf IsNull(v) Or IsEmpty(v) Then
        SafeCStr = ""
    Else
        SafeCStr = CStr(v)
    End If
End Function

' Turn an Error variant (from an array read) into human-readable text.
' Direct CStr() on a CVErr variant raises a type-mismatch, so we map
' the well-known error codes explicitly.
Private Function ErrText(v As Variant) As String
    If Not IsError(v) Then
        ErrText = CStr(v)
        Exit Function
    End If
    Dim code As Long
    code = CLng(v)
    Select Case code
        Case 2000: ErrText = "#NULL!"
        Case 2007: ErrText = "#DIV/0!"
        Case 2015: ErrText = "#VALUE!"
        Case 2023: ErrText = "#REF!"
        Case 2029: ErrText = "#NAME?"
        Case 2036: ErrText = "#NUM!"
        Case 2042: ErrText = "#N/A"
        Case 2043: ErrText = "#GETTING_DATA"
        Case 2045: ErrText = "#SPILL!"
        Case 2046: ErrText = "#CONNECT!"
        Case 2047: ErrText = "#BLOCKED!"
        Case 2048: ErrText = "#UNKNOWN!"
        Case 2049: ErrText = "#FIELD!"
        Case 2050: ErrText = "#CALC!"
        Case Else: ErrText = "Error " & code
    End Select
End Function

'==================================================================
' ================  BASELINE: SAVE / COMPARE / CLEAR  =============
'==================================================================

' Save a snapshot of every non-empty cell (formula + evaluated value)
' to a hidden sheet Audit_Baseline (xlSheetVeryHidden).
Sub SaveBaseline()
    Dim wsB As Worksheet, ws As Worksheet
    Dim outRow As Long, addr As String
    Dim usedRng As Range
    Dim fArr As Variant, vArr As Variant
    Dim rows As Long, cols As Long, r As Long, c As Long
    Dim firstRow As Long, firstCol As Long
    Dim savedCalc As XlCalculation, savedScreen As Boolean, savedStatus As Variant
    Dim tStart As Double, n As Long

    On Error GoTo Fatal
    tStart = Timer

    savedCalc = Application.Calculation
    savedScreen = Application.ScreenUpdating
    savedStatus = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Save Baseline: preparing..."

    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(BASELINE_SHEET).Visible = xlSheetVisible
    ThisWorkbook.Worksheets(BASELINE_SHEET).Delete
    On Error GoTo Fatal
    Application.DisplayAlerts = True

    Set wsB = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    wsB.Name = BASELINE_SHEET
    wsB.Range("A1:E1").Value = Array("Sheet", "Address", "Formula", "Value", "Snapshot")
    wsB.Range("A1:E1").Font.Bold = True
    outRow = 2

    Dim tsStamp As String
    tsStamp = Format(Now, "yyyy-mm-dd hh:mm:ss")

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> REPORT_SHEET And ws.Name <> BASELINE_SHEET _
            And ws.Name <> DIFF_SHEET And ws.Name <> CONFIG_SHEET Then
            Application.StatusBar = "Save Baseline: snapshotting '" & ws.Name & "'..."
            On Error Resume Next
            Set usedRng = Nothing
            Set usedRng = ws.UsedRange
            On Error GoTo Fatal
            If Not usedRng Is Nothing Then
                firstRow = usedRng.Row
                firstCol = usedRng.Column
                rows = usedRng.Rows.Count
                cols = usedRng.Columns.Count
                If rows = 1 And cols = 1 Then
                    ReDim fArr(1 To 1, 1 To 1): fArr(1, 1) = usedRng.Formula
                    ReDim vArr(1 To 1, 1 To 1): vArr(1, 1) = usedRng.Value
                Else
                    fArr = usedRng.Formula
                    vArr = usedRng.Value
                End If
                For r = 1 To rows
                    For c = 1 To cols
                        If Not (IsEmpty(vArr(r, c)) And Len(SafeCStr(fArr(r, c))) = 0) Then
                            addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address
                            wsB.Cells(outRow, 1).Value = ws.Name
                            wsB.Cells(outRow, 2).Value = addr
                            wsB.Cells(outRow, 3).Value = "'" & SafeCStr(fArr(r, c))
                            If IsError(vArr(r, c)) Then
                                wsB.Cells(outRow, 4).Value = "'" & ErrText(vArr(r, c))
                            Else
                                wsB.Cells(outRow, 4).Value = "'" & CStr(vArr(r, c))
                            End If
                            wsB.Cells(outRow, 5).Value = tsStamp
                            outRow = outRow + 1
                            n = n + 1
                        End If
                    Next c
                Next r
            End If
        End If
    Next ws

    wsB.Columns("A:E").AutoFit
    wsB.Visible = xlSheetVeryHidden

    Application.Calculation = savedCalc
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False

    MsgBox "Baseline saved: " & n & " cells snapshotted in " & _
        Format(Timer - tStart, "0.0") & "s." & vbNewLine & _
        "(Hidden sheet '" & BASELINE_SHEET & "' - xlSheetVeryHidden.)", vbInformation
    Exit Sub

Fatal:
    Application.Calculation = savedCalc
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False
    Application.DisplayAlerts = True
    MsgBox "SaveBaseline failed:" & vbNewLine & Err.Number & " - " & Err.Description, vbExclamation
End Sub

' Compare current workbook against Audit_Baseline snapshot and write
' Baseline_Diff with Added / Removed / Formula changed / Value drift.
Sub CompareToBaseline()
    Dim wsB As Worksheet, wsD As Worksheet, ws As Worksheet
    Dim savedCalc As XlCalculation, savedScreen As Boolean, savedStatus As Variant
    Dim tStart As Double

    On Error GoTo Fatal
    tStart = Timer

    On Error Resume Next
    Set wsB = ThisWorkbook.Worksheets(BASELINE_SHEET)
    On Error GoTo Fatal
    If wsB Is Nothing Then
        MsgBox "No baseline found. Run SaveBaseline first.", vbExclamation
        Exit Sub
    End If

    savedCalc = Application.Calculation
    savedScreen = Application.ScreenUpdating
    savedStatus = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Compare to Baseline: loading snapshot..."

    ' --- Load baseline into a keyed Collection ---
    ' key = "Sheet!$A$1"; value = Array(formula, value, snapshot)
    Dim baseKeys As Collection, baseData As Collection
    Set baseKeys = New Collection
    Set baseData = New Collection

    Dim wasHidden As XlSheetVisibility
    wasHidden = wsB.Visible
    wsB.Visible = xlSheetVisible

    Dim lastRow As Long
    lastRow = wsB.Cells(wsB.Rows.Count, 1).End(xlUp).Row
    Dim i As Long, k As String
    Dim snapArr As Variant
    If lastRow >= 2 Then
        snapArr = wsB.Range("A2:D" & lastRow).Value
        For i = 1 To UBound(snapArr, 1)
            k = CStr(snapArr(i, 1)) & "!" & CStr(snapArr(i, 2))
            On Error Resume Next
            baseData.Add Array(CStr(snapArr(i, 3)), CStr(snapArr(i, 4))), k
            If Err.Number = 0 Then baseKeys.Add k
            Err.Clear
            On Error GoTo Fatal
        Next i
    End If

    wsB.Visible = wasHidden

    ' --- Prepare diff report sheet ---
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(DIFF_SHEET).Delete
    On Error GoTo Fatal
    Application.DisplayAlerts = True

    Set wsD = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
    wsD.Name = DIFF_SHEET

    wsD.Range("A1").Value = "BASELINE COMPARISON"
    wsD.Range("A1").Font.Bold = True
    wsD.Range("A1").Font.Size = 14
    wsD.Range("A3:F3").Value = Array("Sheet", "Cell", "Change", "Details", _
                                     "Baseline", "Current")
    wsD.Range("A3:F3").Font.Bold = True
    wsD.Range("A3:F3").Interior.Color = RGB(217, 217, 217)
    wsD.Columns("A:B").ColumnWidth = 18
    wsD.Columns("C").ColumnWidth = 22
    wsD.Columns("D").ColumnWidth = 45
    wsD.Columns("E:F").ColumnWidth = 30

    Dim outRow As Long: outRow = 4
    Dim seen As Collection: Set seen = New Collection

    ' --- Walk the current workbook, compare to baseline ---
    Dim usedRng As Range, fArr As Variant, vArr As Variant
    Dim rows As Long, cols As Long, r As Long, c As Long
    Dim firstRow As Long, firstCol As Long, addr As String
    Dim curF As String, curV As String
    Dim baseF As String, baseV As String, tuple As Variant
    Dim addedCount As Long, removedCount As Long
    Dim fchgCount As Long, vdriftCount As Long

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> REPORT_SHEET And ws.Name <> BASELINE_SHEET _
            And ws.Name <> DIFF_SHEET And ws.Name <> CONFIG_SHEET Then

            Application.StatusBar = "Compare to Baseline: scanning '" & ws.Name & "'..."
            On Error Resume Next
            Set usedRng = Nothing
            Set usedRng = ws.UsedRange
            On Error GoTo Fatal
            If Not usedRng Is Nothing Then
                firstRow = usedRng.Row
                firstCol = usedRng.Column
                rows = usedRng.Rows.Count
                cols = usedRng.Columns.Count
                If rows = 1 And cols = 1 Then
                    ReDim fArr(1 To 1, 1 To 1): fArr(1, 1) = usedRng.Formula
                    ReDim vArr(1 To 1, 1 To 1): vArr(1, 1) = usedRng.Value
                Else
                    fArr = usedRng.Formula
                    vArr = usedRng.Value
                End If

                For r = 1 To rows
                    For c = 1 To cols
                        curF = SafeCStr(fArr(r, c))
                        If IsError(vArr(r, c)) Then
                            curV = ErrText(vArr(r, c))
                        Else
                            curV = CStr(vArr(r, c))
                        End If
                        If Len(curF) = 0 And Len(curV) = 0 Then GoTo NextCmp

                        addr = ws.Cells(firstRow + r - 1, firstCol + c - 1).Address
                        k = ws.Name & "!" & addr
                        seen.Add k, k

                        baseF = "": baseV = ""
                        On Error Resume Next
                        tuple = baseData(k)
                        If Err.Number = 0 Then
                            baseF = CStr(tuple(0))
                            baseV = CStr(tuple(1))
                        End If
                        Err.Clear
                        On Error GoTo Fatal

                        If Len(baseF) = 0 And Len(baseV) = 0 Then
                            ' Not in baseline -> Added
                            WriteDiffRow wsD, outRow, ws.Name, addr, "Added", _
                                "Cell present now but not in baseline", "", _
                                IIf(Len(curF) > 0, curF, curV), RGB(198, 239, 206)
                            addedCount = addedCount + 1
                        Else
                            If curF <> baseF Then
                                WriteDiffRow wsD, outRow, ws.Name, addr, "Formula changed", _
                                    "Formula differs from baseline", baseF, curF, _
                                    RGB(255, 199, 206)
                                fchgCount = fchgCount + 1
                            ElseIf ValuesDiffer(baseV, curV) Then
                                WriteDiffRow wsD, outRow, ws.Name, addr, "Value drift", _
                                    "Same formula (or both static) but value differs by more than tolerance", _
                                    baseV, curV, RGB(255, 235, 156)
                                vdriftCount = vdriftCount + 1
                            End If
                        End If
NextCmp:
                    Next c
                Next r
            End If
        End If
    Next ws

    ' --- Anything in the baseline we didn't visit is Removed ---
    Application.StatusBar = "Compare to Baseline: computing removals..."
    For i = 1 To baseKeys.Count
        k = baseKeys(i)
        Dim found As Boolean: found = False
        On Error Resume Next
        Dim tmp As Variant: tmp = seen(k)
        If Err.Number = 0 Then found = True
        Err.Clear
        On Error GoTo Fatal
        If Not found Then
            Dim bang As Long: bang = InStrRev(k, "!")
            Dim rs As String, ra As String
            rs = Left$(k, bang - 1)
            ra = Mid$(k, bang + 1)
            tuple = baseData(k)
            baseF = CStr(tuple(0)): baseV = CStr(tuple(1))
            WriteDiffRow wsD, outRow, rs, ra, "Removed", _
                "Cell present in baseline but empty now", _
                IIf(Len(baseF) > 0, baseF, baseV), "", RGB(217, 217, 217)
            removedCount = removedCount + 1
        End If
    Next i

    ' --- Header summary ---
    wsD.Range("A2").Value = "Added: " & addedCount & _
        "   Removed: " & removedCount & _
        "   Formula changed: " & fchgCount & _
        "   Value drift: " & vdriftCount & _
        "   (tolerance " & VALUE_TOLERANCE & ")"
    wsD.Range("A2").Font.Bold = True

    If outRow > 4 Then wsD.Range("A3:F" & (outRow - 1)).AutoFilter

    Application.Calculation = savedCalc
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False
    wsD.Activate
    wsD.Range("A1").Select

    MsgBox "Comparison complete in " & Format(Timer - tStart, "0.0") & "s." & vbNewLine & _
        "Added: " & addedCount & "   Removed: " & removedCount & vbNewLine & _
        "Formula changed: " & fchgCount & "   Value drift: " & vdriftCount & vbNewLine & _
        "See '" & DIFF_SHEET & "'.", vbInformation
    Exit Sub

Fatal:
    Application.Calculation = savedCalc
    Application.ScreenUpdating = savedScreen
    Application.DisplayStatusBar = savedStatus
    Application.StatusBar = False
    Application.DisplayAlerts = True
    MsgBox "CompareToBaseline failed:" & vbNewLine & Err.Number & " - " & Err.Description, _
        vbExclamation
End Sub

' Delete the hidden baseline snapshot.
Sub ClearBaseline()
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets(BASELINE_SHEET).Visible = xlSheetVisible
    ThisWorkbook.Worksheets(BASELINE_SHEET).Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    MsgBox "Baseline cleared.", vbInformation
End Sub

Private Sub WriteDiffRow(wsD As Worksheet, ByRef outRow As Long, _
    sheetName As String, cellAddr As String, change As String, _
    details As String, baseline As String, current As String, rowColor As Long)

    wsD.Cells(outRow, 1).Value = sheetName
    wsD.Cells(outRow, 2).Value = cellAddr
    wsD.Cells(outRow, 3).Value = change
    wsD.Cells(outRow, 4).Value = details
    wsD.Cells(outRow, 5).Value = "'" & baseline
    wsD.Cells(outRow, 6).Value = "'" & current
    wsD.Range("A" & outRow & ":F" & outRow).Interior.Color = rowColor

    On Error Resume Next
    wsD.Hyperlinks.Add Anchor:=wsD.Cells(outRow, 2), _
        Address:="", _
        SubAddress:="'" & sheetName & "'!" & cellAddr, _
        TextToDisplay:=cellAddr
    On Error GoTo 0

    outRow = outRow + 1
End Sub

' Numeric-aware value comparison so 100 vs. 100.0000001 doesn't
' show as drift, but 100 vs. 101 does.  Non-numeric falls back to
' string compare.
Private Function ValuesDiffer(baseV As String, curV As String) As Boolean
    If baseV = curV Then Exit Function
    If IsNumeric(baseV) And IsNumeric(curV) Then
        ValuesDiffer = Abs(CDbl(baseV) - CDbl(curV)) > VALUE_TOLERANCE
    Else
        ValuesDiffer = True
    End If
End Function