VBA Macro to find Duplicates using Ranges

Hi

VBA noob here, been searching for 2 days to find a script i can modify for my needs but keep getting stuck or not be able to make anything work for my specific situation.

I'm trying to write a simple but specific macro to find and color duplicates in ranges.

My search criteria is in Range(B5:B405) Data to be scanned and colored is located in Range(D5:OM1004)

The data is only numbers and needs to be an exact match to the search criteria, if cell in data is found to exist in search criteria then data cell is filled red.

I also need to stop the script at data row 1004 and display a message with total execution time at the end.

I can do this in seconds with Conditional Formatting but I need to count the colored cells after and no VBA Macros i can find will let me count conditionally formatted colors, even been through all of cpearson's site without success.


Working Code is here, i hope this helps someone in the future.

Option Explicit
Sub ColorCriteria()
    Dim rCriteria As Range
    Dim rData As Range
    Dim c As Range, r As Range
    Dim sFirstAddress As String
    Dim ColorCounter As Long
    Dim StartTime As Single, EndTime As Single

StartTime = Timer
Set rCriteria = Range("B5:B405")
Set rData = Range("D5:OM1004")

Application.ScreenUpdating = False
With rData
    .Interior.ColorIndex = xlNone

For Each r In rCriteria
    If Not r = "" Then
    Set c = .Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole, _
            searchdirection:=xlNext)
    If Not c Is Nothing Then
        sFirstAddress = c.Address
        c.Interior.Color = vbRed

        Do
            Set c = .FindNext(c)
            c.Interior.Color = vbRed
            ColorCounter = ColorCounter + 1
        Loop Until c.Address = sFirstAddress
    End If
    End If
Next r

End With
Application.ScreenUpdating = True
EndTime = Timer

MsgBox ("Execution Time: " & Format(EndTime - StartTime, "0.000"" sec""") _
    & vbLf & "Colored Cell Count: " & ColorCounter)


End Sub