Attribute VB_Name = "HighlightDuplicatesSelectedRange"
Option Explicit

' MacroWise Starter Kit
' Macro 2: Highlight duplicate entries in the selected range
' Compatible with Excel 2016+

Public Sub HighlightDuplicatesInSelection()
    Dim selectedRange As Range
    Dim currentCell As Range
    Dim duplicateCounts As Object
    Dim duplicateTotal As Long
    Dim normalizedKey As String

    On Error GoTo CleanFail

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select the range you want to scan for duplicates, then run the macro again.", vbExclamation, "MacroWise"
        Exit Sub
    End If

    Set selectedRange = Selection
    If selectedRange.Cells.CountLarge < 2 Then
        MsgBox "Select at least two cells.", vbExclamation, "MacroWise"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set duplicateCounts = CreateObject("Scripting.Dictionary")
    duplicateCounts.CompareMode = vbTextCompare

    selectedRange.Interior.Pattern = xlSolid
    selectedRange.Interior.PatternColorIndex = xlAutomatic
    selectedRange.Interior.ColorIndex = xlNone
    selectedRange.Font.Color = RGB(26, 26, 26)
    selectedRange.Font.Bold = False

    For Each currentCell In selectedRange.Cells
        normalizedKey = NormalizeDuplicateKey(currentCell.Value)
        If Len(normalizedKey) > 0 Then
            If duplicateCounts.Exists(normalizedKey) Then
                duplicateCounts(normalizedKey) = duplicateCounts(normalizedKey) + 1
            Else
                duplicateCounts.Add normalizedKey, 1
            End If
        End If
    Next currentCell

    For Each currentCell In selectedRange.Cells
        normalizedKey = NormalizeDuplicateKey(currentCell.Value)
        If Len(normalizedKey) > 0 Then
            If duplicateCounts.Exists(normalizedKey) Then
                If CLng(duplicateCounts(normalizedKey)) > 1 Then
                    currentCell.Interior.Color = RGB(255, 231, 236)
                    currentCell.Font.Color = RGB(156, 0, 6)
                    currentCell.Font.Bold = True
                    duplicateTotal = duplicateTotal + 1
                End If
            End If
        End If
    Next currentCell

    If duplicateTotal = 0 Then
        MsgBox "No duplicates were found in the selected range.", vbInformation, "MacroWise"
    Else
        MsgBox duplicateTotal & " duplicate cells highlighted." & vbCrLf & vbCrLf & _
               "Tip: run ClearDuplicateHighlightsInSelection to remove the formatting later.", _
               vbInformation, "MacroWise"
    End If

CleanExit:
    Application.ScreenUpdating = True
    Exit Sub

CleanFail:
    MsgBox "Duplicate scan stopped: " & Err.Description, vbCritical, "MacroWise"
    Resume CleanExit
End Sub

Public Sub ClearDuplicateHighlightsInSelection()
    Dim selectedRange As Range

    If TypeName(Selection) <> "Range" Then
        MsgBox "Select the previously highlighted range first.", vbExclamation, "MacroWise"
        Exit Sub
    End If

    Set selectedRange = Selection

    selectedRange.Interior.Pattern = xlSolid
    selectedRange.Interior.PatternColorIndex = xlAutomatic
    selectedRange.Interior.ColorIndex = xlNone
    selectedRange.Font.Color = RGB(26, 26, 26)
    selectedRange.Font.Bold = False

    MsgBox "Duplicate highlighting removed from the selected range.", vbInformation, "MacroWise"
End Sub

Private Function NormalizeDuplicateKey(ByVal cellValue As Variant) As String
    If IsError(cellValue) Then
        NormalizeDuplicateKey = ""
        Exit Function
    End If

    If IsDate(cellValue) Then
        NormalizeDuplicateKey = "DATE|" & Format$(CDate(cellValue), "yyyymmdd")
    ElseIf IsNumeric(cellValue) Then
        NormalizeDuplicateKey = "NUM|" & Format$(CDbl(cellValue), "0.000000")
    Else
        NormalizeDuplicateKey = Trim$(LCase$(CStr(cellValue)))
    End If
End Function