Highlighting Duplicate Cells in a Split Range

[oleander]

Hi everyone! I'm using the following macro to highlight cells in a range that are duplicates, but it seems to have a problem when I highlight split ranges (something like $A$1,$A$3:$A$14). Is there a way to fix this?

Sub HighlightDuplicateValues()
Dim myRange As Range
Dim myCell As Range
Set myRange = Selection
For Each myCell In myRange
If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
myCell.Interior.ColorIndex = 36
End If
Next myCell
End Sub

Thanks!

[mjr veverka]

... a problem when I highlight split ranges (something like $A$1,$A$3:$A$14) ...

For separated ranges, use e.g. the "Areas" property. Besides, not every function can be used in this case, you need to look for replacements, e.g.:

Option Explicit

Sub HighlightDuplicateValues_v1()
    Dim elmnt
    Dim clr As Integer: clr = 2
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim myRange As Range: Set myRange = Selection
    Dim sngArea As Range, myCell As Range
    
    For Each sngArea In myRange.Areas
        For Each myCell In sngArea
            If Not dict.Exists(myCell.Value) Then dict(myCell.Value) = 1 Else dict(myCell.Value) = dict(myCell.Value) + 1
        Next
    Next
    
    For Each elmnt In dict.Keys
        If dict(elmnt) > 1 Then
            clr = clr + 1
            With Application.ReplaceFormat.Interior
                Select Case clr
                    Case Is <= 56: .ColorIndex = clr: .Pattern = xlSolid
                    Case 57 To 110: .ColorIndex = clr - 54: .Pattern = xlGray8: .PatternColorIndex = xlAutomatic
                    Case Else: .ColorIndex = 0: .Pattern = xlCrissCross: .PatternColorIndex = xlAutomatic
                End Select
            End With
            myRange.Replace What:=elmnt, Replacement:=elmnt, LookAt:=xlWhole, SearchOrder:=xlByRows, ReplaceFormat:=True
        End If
    Next
    
    Set myRange = Nothing
    dict.RemoveAll: Set dict = Nothing
End Sub