Duplicate Highlighter: Spot Double-Entered TB Lines Before the Reviewer Does

TL;DR: Scroll through 300 TB lines hunting for duplicate account codes, or run this macro. Select a column, click OK, and every duplicated value lights up in yellow. Three duplicates across 142 unique values — all flagged in under a second. No deletions, no data changes. Just highlights. You make the call.

#Prerequisites & Setup

What you’ll need:

• Excel 2016+ (desktop)
• A sheet with data in columns, row 1 as headers
• Values in the column you’re checking must be text, numbers, or account codes — blank cells are skipped

Limitations:

• Only checks one column at a time — run multiple times for multi-column checks
• Highlights entire rows yellow; any existing yellow fills in the data range are cleared if you choose the “clear existing” option
• Case-sensitive comparison — "11010" and " 11010" (with a leading space) are treated as different values. Clean your data first or use Tab Normalizer
• The first occurrence of each duplicate is highlighted too (so you can see exactly which rows are the same) — the macro does NOT guess which one to keep

#The Macro

Option Explicit

Sub HighlightDuplicates()
    ' ── Duplicate Highlighter ─────────────────────────
    ' Select a column. This macro highlights every row
    ' where the value in that column appears more than
    ' once. Light yellow fill, no deletions. Reports:
    ' "3 duplicate(s) across 142 unique values."
    '
    ' Non-destructive — only adds fill color.
    ' Review the yellow rows and decide what to delete.
    ' ───────────────────────────────────────────────────

    ' ── Configuration ──────────────────────────────────
    Const HIGHLIGHT_COLOR As Long = 65535   ' Light yellow

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

    ' ── Variables ──────────────────────────────────────
    Dim ws As Worksheet, colRng As Range
    Dim dict As Object, keys As Variant, k As Variant
    Dim lastRow As Long, i As Long, colNum As Long
    Dim cellVal As String, headerRow As Long
    Dim uniqueCount As Long, dupCount As Long
    Dim dupRows As Long

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

    Set ws = ActiveSheet
    headerRow = 1

    ' ── Step 1: Select the column to check ─────────────
    On Error Resume Next
    Set colRng = Application.InputBox( _
        "Select the column to check for duplicates " & _
        "(click any cell in that column)", _
        "Duplicate Highlighter", Type:=8)
    On Error GoTo CleanUp

    If colRng Is Nothing Then
        MsgBox "No column selected. Macro cancelled.", vbExclamation
        GoTo CleanUp
    End If

    colNum = colRng.Column
    lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row

    If lastRow <= headerRow Then
        MsgBox "No data found in column " & ColLetter(colNum) & ".", _
               vbExclamation
        GoTo CleanUp
    End If

    ' ── Step 2: Ask about existing fills ───────────────
    Dim lastCol As Long
    lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column

    If MsgBox("Clear all existing cell fills before scanning?", _
              vbYesNo + vbQuestion, "Existing Highlights") = vbYes Then
        ws.Range(ws.Cells(headerRow + 1, 1), _
            ws.Cells(lastRow, lastCol)).Interior.ColorIndex = xlNone
    End If

    ' ── Step 3: Count occurrences with Dictionary ──────
    Set dict = CreateObject("Scripting.Dictionary")

    For i = headerRow + 1 To lastRow
        cellVal = Trim(CStr(ws.Cells(i, colNum).Value & ""))
        If cellVal <> "" Then
            If dict.Exists(cellVal) Then
                dict(cellVal) = dict(cellVal) + 1
            Else
                dict.Add cellVal, 1
            End If
        End If
    Next i

    uniqueCount = dict.Count
    dupCount = 0
    keys = dict.Keys
    For Each k In keys
        If dict(k) > 1 Then dupCount = dupCount + 1
    Next k

    If dupCount = 0 Then
        MsgBox "No duplicates found in column " & _
               ColLetter(colNum) & "." & vbCrLf & vbCrLf & _
               uniqueCount & " unique value(s) scanned.", _
               vbInformation, "No Duplicates"
        GoTo CleanUp
    End If

    ' ── Step 4: Show preview and confirm ───────────────
    Dim dupList As String, listed As Long
    dupList = ""
    listed = 0
    For Each k In keys
        If dict(k) > 1 And listed < 5 Then
            dupList = dupList & "  • " & k & " (" & dict(k) & "×)" & vbCrLf
            listed = listed + 1
        End If
    Next k
    If dupCount > 5 Then
        dupList = dupList & "  ... and " & (dupCount - 5) & " more" & vbCrLf
    End If

    If MsgBox("Found " & dupCount & " duplicate value(s) across " & _
              uniqueCount & " unique value(s) in column " & _
              ColLetter(colNum) & "." & vbCrLf & vbCrLf & _
              dupList & vbCrLf & "Highlight these rows in yellow?", _
              vbYesNo + vbQuestion, "Confirm") = vbNo Then
        MsgBox "Macro cancelled. No changes made.", vbInformation
        GoTo CleanUp
    End If

    ' ── Step 5: Highlight duplicate rows ───────────────
    dupRows = 0
    For i = headerRow + 1 To lastRow
        cellVal = Trim(CStr(ws.Cells(i, colNum).Value & ""))
        If cellVal <> "" Then
            If dict(cellVal) > 1 Then
                ws.Cells(i, colNum).EntireRow.Interior.Color = HIGHLIGHT_COLOR
                dupRows = dupRows + 1
            End If
        End If
    Next i

    ' ── Step 6: Summary ────────────────────────────────
    MsgBox dupCount & " duplicate value(s) across " & _
           uniqueCount & " unique value(s)." & vbCrLf & _
           dupRows & " row(s) highlighted in column " & _
           ColLetter(colNum) & "." & vbCrLf & vbCrLf & _
           "Review the yellow rows and delete duplicates " & _
           "manually.", vbInformation, "Done"

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: Convert column number to letter ────────────
Private Function ColLetter(colNum As Long) As String
    ColLetter = Split(Cells(1, colNum).Address(True, False), "$")(0)
End Function

#How It Works

#Click a column instead of typing a letter

Application.InputBox(Type:=8) opens a range-selection prompt. The user clicks any cell in the column they want to scan. The macro extracts colRng.Column to get the column number, and ColLetter() converts it to a readable letter for the message box.

No typing column letters. No guessing whether the account codes are in column A or column C. Point and click.

#Dictionary counts first, highlights second

Set dict = CreateObject("Scripting.Dictionary")

For i = headerRow + 1 To lastRow
    cellVal = Trim(CStr(ws.Cells(i, colNum).Value & ""))
    If cellVal <> "" Then
        If dict.Exists(cellVal) Then
            dict(cellVal) = dict(cellVal) + 1
        Else
            dict.Add cellVal, 1
        End If
    End If
Next i

The macro makes two passes. Pass one builds a Dictionary where each key is a cell value and each value is how many times it appears. Pass two re-reads the same cells and highlights every row whose value has a count > 1.

The Dictionary is why this is fast. A conventional approach — checking every cell against every other cell — is O(n²) and chokes on 300 rows. The Dictionary approach is O(n) and handles thousands of rows in under a second.

#You see what it found before it acts

After counting, the macro shows a preview message box with up to five sample duplicates and their counts — e.g., 11010 (2×). If a column has 50 duplicate values, the first 5 are listed and the rest summarized as ... and 45 more.

A second vbYesNo message box gives you a chance to back out. If you cancel, the macro exits with no changes. This is the moment to realize the column you selected is wrong, or that a particular duplicate is a valid accounting entry (like a reversing JE that legitimately appears twice).

#Entire rows get highlighted, not just cells

ws.Cells(i, colNum).EntireRow.Interior.Color = HIGHLIGHT_COLOR

Conditional Formatting’s built-in “Duplicate Values” rule highlights individual cells, but a duplicate account code usually means the entire row is suspicious. Highlighting the full row lets you scan the Description, Debit, and Credit columns side by side to decide which rows are the genuine entry and which are the mistaken ones.

#The “clear existing fills” prompt

Before scanning, the macro asks: “Clear all existing cell fills?” If you say yes, it strips all background colors from the data range — header row excluded — so the yellow highlights are the only color on the sheet. If you say no, yellow is applied on top of existing formatting. This is useful when you want to run the macro on different columns sequentially without erasing previous results.

#Every duplicate gets highlighted, including the first one

The macro highlights every occurrence — not just the second, third, or nth instance. All rows sharing a duplicated value light up yellow. This is intentional. The macro doesn’t know which is the “real” entry and which is the mistake. Maybe it’s not a mistake — maybe both entries are correct (a reversing entry that appears in two JE batches). You, the preparer who knows the data, make the final call.

#Adapt It