Rounding Auditor: Find the Hidden Pennies Breaking Your Schedules

TL;DR: Three cells in your workpaper show $1,234, $5,678, and $9,101 but actually contain $1,233.67, $5,677.81, and $9,101.44. The schedule doesn’t foot and you can’t figure out why. This macro scans every numeric cell, compares what you see to what Excel stores, and drops every mismatch into a color-coded report sheet — largest discrepancies first.

The Problem

The Henderson engagement is due at noon. The Schedule L balance sheet totals to $2,847,500 on the Assets side and $2,847,200 on the Liabilities side — a $300 gap that didn’t exist yesterday. You open every schedule looking for the problem. Nothing is obviously wrong. Every cell shows clean whole-dollar amounts.

Then you remember: last week the senior formatted everything to zero decimal places to make the workpaper presentable. The subtotal that shows $1,234 actually contains $1,233.67. The displayed numbers foot perfectly. The real numbers don’t.

You either: a) click into 200 cells checking the formula bar one at a time, or b) run this macro and see every hidden fractional cent in one report.

#Prerequisites & Setup

What you’ll need:

Excel 2016+ (desktop)
A workpaper where cells are formatted to a lower precision than their underlying values (e.g., zero-decimal format on fractional dollars)
The macro scans the active sheet only — navigate to the sheet you want to audit before running

Limitations:

Does not flag cells whose displayed value rounds to the same number as the underlying value (e.g., $1,233.998 formatted to whole dollars shows $1,234 — both round to $1,234, so no flag)
Custom number formats that append text (e.g., #,##0 "K" to show thousands) may not parse correctly — cells using these formats are skipped
Skipped cells are counted in the final report so you know they weren’t missed
Dates formatted as numbers (serial dates) are skipped automatically
Only scans the UsedRange — data outside Excel’s tracked range is ignored

#The Macro

Option Explicit

Sub AuditRounding()
    ' ── Rounding Auditor ─────────────────────────────────
    ' Scans the active sheet for cells where the displayed
    ' value (per the number format) differs from the actual
    ' stored value. Writes discrepancies to a new
    ' "Rounding-Report" sheet with color-coded severity.
    '
    ' Color key:
    '   Red  — difference ≥ $1.00 (schedule-critical)
    '   Yellow — difference ≥ $0.10 (likely material)
    '   None  — difference < $0.10 (minor rounding)
    '
    ' The report is sorted largest-difference-first so you
    ' can triage the biggest problems immediately.
    ' ────────────────────────────────────────────────────

    ' ── Configuration ──────────────────────────────────
    Const THRESHOLD As Double = 0.01   ' Minimum difference to flag
    Const OUT_SHEET As String = "Rounding-Report"

    ' ── State management ───────────────────────────────
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' ── Variables ──────────────────────────────────────
    Dim ws As Worksheet, wsOut As Worksheet
    Dim cell As Range
    Dim rawValue As Double, displayedText As String
    Dim displayedValue As Variant, diff As Double
    Dim flagged As Long, scanned As Long, skipped As Long
    Dim outRow As Long, wsName As String

    ' ── Error handling ─────────────────────────────────
    On Error GoTo CleanUp

    Set ws = ActiveSheet
    wsName = ws.Name

    If WorksheetFunction.CountA(ws.UsedRange) = 0 Then
        MsgBox "No data found on this sheet.", vbExclamation
        GoTo CleanUp
    End If

    ' ── Create output sheet ────────────────────────────
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(OUT_SHEET).Delete
    Application.DisplayAlerts = True
    On Error GoTo CleanUp

    Set wsOut = ThisWorkbook.Worksheets.Add( _
        After:=ThisWorkbook.Worksheets( _
            ThisWorkbook.Worksheets.Count))
    wsOut.Name = OUT_SHEET

    ' ── Write headers ──────────────────────────────────
    wsOut.Range("A1:F1").Value = Array( _
        "Cell", "Displayed", "Actual Value", _
        "Difference", "Severity", "Number Format")
    wsOut.Range("A1:F1").Font.Bold = True
    wsOut.Range("A1:F1").Interior.Color = RGB(50, 50, 50)
    wsOut.Range("A1:F1").Font.Color = vbWhite

    ' ── Scan every numeric cell ────────────────────────
    outRow = 2
    flagged = 0
    scanned = 0
    skipped = 0

    For Each cell In ws.UsedRange
        ' Skip blanks, text, dates, errors
        If IsEmpty(cell) Then GoTo NextCell
        If Not IsNumeric(cell.Value2) Then GoTo NextCell
        If IsError(cell.Value2) Then GoTo NextCell
        If IsDate(cell) And Not IsNumeric(cell.Text) Then GoTo NextCell
        If cell.Value2 = 0 Then GoTo NextCell  ' Skip zeros

        scanned = scanned + 1
        rawValue = CDbl(cell.Value2)
        displayedText = cell.Text

        displayedValue = ParseDisplayedNumber(displayedText)
        If IsError(displayedValue) Then
            skipped = skipped + 1
            GoTo NextCell
        End If

        diff = Abs(rawValue - displayedValue)

        ' ── Threshold check ────────────────────────────
        If diff < THRESHOLD Then GoTo NextCell

        ' ── Write to report ────────────────────────────
        ' Hyperlinked cell address
        wsOut.Hyperlinks.Add _
            Anchor:=wsOut.Cells(outRow, 1), _
            Address:="", _
            SubAddress:="'" & wsName & "'!" & _
                cell.Address(False, False), _
            TextToDisplay:=cell.Address(False, False)

        wsOut.Cells(outRow, 2).Value = displayedText
        wsOut.Cells(outRow, 3).Value = rawValue
        wsOut.Cells(outRow, 3).NumberFormat = "#,##0.00######"
        wsOut.Cells(outRow, 4).Value = Round(diff, 4)
        wsOut.Cells(outRow, 4).NumberFormat = "#,##0.00##"
        wsOut.Cells(outRow, 6).Value = cell.NumberFormat

        ' ── Severity rating & color ────────────────────
        Dim severity As String
        If diff >= 1 Then
            severity = "HIGH — over $1.00"
            wsOut.Range("A" & outRow & ":F" & outRow). _
                Interior.Color = RGB(254, 202, 202)
        ElseIf diff >= 0.1 Then
            severity = "MEDIUM — $0.10 to $0.99"
            wsOut.Range("A" & outRow & ":F" & outRow). _
                Interior.Color = RGB(254, 240, 138)
        Else
            severity = "LOW — under $0.10"
        End If
        wsOut.Cells(outRow, 5).Value = severity

        flagged = flagged + 1
        outRow = outRow + 1

NextCell:
    Next cell

    ' ── Format report ──────────────────────────────────
    If flagged > 0 Then
        With wsOut
            .Columns("A:F").AutoFit
            .Columns("B").ColumnWidth = 16
            .Columns("C").ColumnWidth = 18
            .Columns("D").ColumnWidth = 14
            .Columns("E").ColumnWidth = 22
            .Columns("F").ColumnWidth = 22
            .Range("A1").Select
            ActiveWindow.FreezePanes = True
        End With

        ' Sort largest difference first
        wsOut.Sort.SortFields.Clear
        wsOut.Sort.SortFields.Add _
            Key:=wsOut.Range("D2:D" & outRow - 1), _
            SortOn:=xlSortOnValues, _
            Order:=xlDescending
        With wsOut.Sort
            .SetRange wsOut.Range("A1:F" & outRow - 1)
            .Header = xlYes
            .Apply
        End With
    End If

    ' ── Summary message ────────────────────────────────
    Dim msg As String
    If flagged = 0 Then
        msg = scanned & " numeric cell(s) scanned on '" & _
              wsName & "'. No rounding discrepancies found."
        If skipped > 0 Then
            msg = msg & vbCrLf & skipped & _
                  " cell(s) skipped (unparseable formats)."
        End If
    Else
        Dim highCount As Long, medCount As Long, lowCount As Long
        Dim r As Long
        For r = 2 To outRow - 1
            Select Case Left(wsOut.Cells(r, 5).Value, 3)
                Case "HIG": highCount = highCount + 1
                Case "MED": medCount = medCount + 1
                Case "LOW": lowCount = lowCount + 1
            End Select
        Next r

        msg = scanned & " numeric cell(s) scanned on '" & _
              wsName & "'." & vbCrLf & vbCrLf
        msg = msg & flagged & " rounding discrepancy(s):" & vbCrLf
        msg = msg & "  HIGH:   " & highCount & vbCrLf
        msg = msg & "  MEDIUM: " & medCount & vbCrLf
        msg = msg & "  LOW:    " & lowCount & vbCrLf
        If skipped > 0 Then
            msg = msg & vbCrLf & skipped & _
                  " cell(s) skipped (unparseable formats)."
        End If
        msg = msg & vbCrLf & vbCrLf & "See '" & OUT_SHEET & _
              "' sheet sorted by severity (largest first)."
    End If

    MsgBox msg, vbInformation, "Rounding Audit Complete"

CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
               vbCritical, "Macro Error"
    End If
End Sub

' ── Helper: Parse a displayed number string ────────────
' Strips currency symbols, commas, and parentheses.
' Returns the double value or a CVErr on failure.
Private Function ParseDisplayedNumber(txt As String) As Variant
    Dim s As String, clean As String
    Dim i As Long, ch As String, code As Long

    s = Trim(txt)
    If Len(s) = 0 Then
        ParseDisplayedNumber = CVErr(xlErrValue): Exit Function
    End If

    ' Parentheses = negative (accounting format)
    If Left(s, 1) = "(" And Right(s, 1) = ")" Then
        s = "-" & Mid(s, 2, Len(s) - 2)
    End If

    ' Build clean string — keep only minus, period, digits
    clean = ""
    For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        code = Asc(ch)
        If code = 45 Or code = 46 Or _
           (code >= 48 And code <= 57) Then
            ' minus, period, digit — keep it
            clean = clean & ch
        End If
    Next i

    If Len(clean) = 0 Then
        ParseDisplayedNumber = CVErr(xlErrValue): Exit Function
    End If

    On Error Resume Next
    ParseDisplayedNumber = CDbl(clean)
    If Err.Number <> 0 Then ParseDisplayedNumber = CVErr(xlErrValue)
    On Error GoTo 0
End Function

#How It Works

#It compares two different versions of the same number

Every cell in Excel stores two values simultaneously: the actual value (what you see in the formula bar) and the displayed value (what you see in the cell, after number formatting is applied). This macro harvests both:

cell.Value2 — the raw stored number, e.g., 1247.534
cell.Text — what the cell actually shows, e.g., "$1,248" or "1,247.53"

It then strips the formatting characters off cell.Text, converts it to a number, and subtracts the raw value. If the difference exceeds the threshold (default: $0.01), the cell is flagged.

#The helper parses displayed numbers, not just values

The ParseDisplayedNumber function is the engine. It strips currency symbols ($, £, €, ¥), thousands separators, accounting-format parentheses for negatives, and any other non-digit characters. Once only digits, a minus sign, and one decimal point remain, it converts to a Double.

If Left(s, 1) = "(" And Right(s, 1) = ")" Then
    s = "-" & Mid(s, 2, Len(s) - 2)
End If

This is necessary because VBA has no built-in function to parse a formatted number string. CDbl("$1,247.53") throws a type mismatch error. The helper cleans the string so CDbl can handle it.

#Three severity tiers, not a binary flag

Not all rounding discrepancies are equal. A $0.02 difference on a single line item is noise. A $1,247 difference is a schedule that won’t foot. The macro assigns three tiers:

Difference	Severity	Color	Why it matters
≥ $1.00	HIGH	Red	Cumulative effect likely breaks a footer
$0.10–$0.99	MEDIUM	Yellow	Could cascade through subtotals
Under $0.10	LOW	None	Individual line rounding, probably fine

These thresholds aren’t arbitrary — they track how rounding errors compound. A column of 20 cells each off by $0.05 (all LOW) can produce a $1.00 HIGH discrepancy at the subtotal. The color coding lets you triage: open the report, scroll to the red rows first, then yellow, and audit LOW only if time permits.

#Sorted largest-difference-first

wsOut.Sort.SortFields.Add _
    Key:=wsOut.Range("D2:D" & outRow - 1), _
    SortOn:=xlSortOnValues, _
    Order:=xlDescending

The report is sorted descending by difference so the worst offenders are at the top. Open the report, see the top three rows, and you know immediately where to start investigating.

#Clickable cell addresses — one click back to the source

Each flagged cell’s address in column A is a hyperlink back to the original sheet. Click D14 and Excel jumps directly to cell D14 on your workpaper. You can see the cell in context, check the formula bar, and decide whether to fix it — all without leaving the report.

#Why zeros and dates are skipped

Skipping zeros eliminates the most common false positive: an empty cell that displays as "-" or "$0.00". The underlying value is 0, the displayed text is non-numeric, and the difference is meaningless. Skipping dates avoids flagging every date cell (e.g., 12/31/2026 which Excel stores as a serial number like 45382).

#Adapt It

Scan the entire workbook, not just one sheet. Wrap the core scan in a For Each ws loop and add a sheet name column to the output:

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = OUT_SHEET Then GoTo NextSheet
    ' ... core scan logic using ws instead of ActiveSheet ...
    wsOut.Cells(outRow, 1).Value = ws.Name & "!" & cell.Address(False, False)
NextSheet:
Next ws

Change the threshold. Set THRESHOLD to a higher value if you only want material discrepancies (e.g., 0.10 for $0.10 or more):

Const THRESHOLD As Double = 0.10  ' Ignore sub-10-cent differences

Flag ALL rounding — including zero thresholds. Set THRESHOLD = 0 to catch every difference, even sub-penny floating-point artifacts. Useful for forensic audits but generates a lot of noise.

Highlight the offending cells on the original sheet. Add this inside the If-block after flagging a cell to make the source sheet’s discrepancies visible:

cell.Interior.Color = RGB(254, 202, 202)  ' Red background

Run on a user-selected range. Replace For Each cell In ws.UsedRange with a range selector for targeted audits:

Dim scanRng As Range
On Error Resume Next
Set scanRng = Application.InputBox( _
    "Select the range to audit for rounding", Type:=8)
If scanRng Is Nothing Then GoTo CleanUp
On Error GoTo CleanUp

For Each cell In scanRng
    ' ... rest of the scan logic ...
Next cell

Customize the severity thresholds. Change the breakpoints in the If-block inside the scan loop:

If diff >= 5 Then             ' $5+ is HIGH
    severity = "HIGH"
ElseIf diff >= 0.5 Then       ' $0.50+ is MEDIUM
    severity = "MEDIUM"
Else
    severity = "LOW"
End If

See also: Hard-Coded Number Detector — finds typed numbers hiding in formula columns. Pair with this macro for a complete workpaper integrity audit. For before-and-after validation after fixing the discrepancies, see Two-Year TB Comparator.

Download the rounding auditor sample workbook (balance sheet, income statement, and depreciation schedule with hidden fractional amounts)

xlsx 8 KB