finding duplicate column D

[missy22]

hi,

I am trying to get the following macro, to read column D and highlight any rows, which contain duplicate cells from column D.

Please view the attachment for further details, as to what the output should look like, when there is duplicate in column D.
test1.xlsx

The below code is throwing back a run-time error 9. I am little unclear what is causing this behavior.
Please advice further, if possible.

Sub test()
Dim rng As Range, c As Range, cfind As Range, rng1 As Range
Worksheets("room list").Activate
Set rng = Range(Range("D2"), Range("D2").End(xlDown))
Set rng1 = Range(Range("B2"), Range("B2").End(xlDown))

For Each c In rng
Set cfind = rng1.Cells.Find(what:=c.Value, lookat:=xlWhole)
If Not cfind Is Nothing Then c.Interior.ColorIndex = 3
Next c
End Sub

Many thanks

[PCI]

Try

Option Explicit

Sub test()
Dim rng As Range, c As Range, cfind As Range, rng1 As Range
With Worksheets("Room_list")
    Set rng = .Range("D2:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With

    For Each c In rng
        If (Application.CountIf(rng, c.Value) >= 2) Then c.Interior.ColorIndex = 3
    Next c
End Sub

[missy22]

Thank you very much for your great help. The code works great

i would like to request, if it would be possible highlight the entire row, instead of the duplicate cells in column D.

Thank you for your time & help.

[PCI]

See here

Option Explicit

Sub test()
Dim rng As Range, c As Range, cfind As Range, rng1 As Range
With Worksheets("Room_list")
    Set rng = .Range("D2:D" & .Range("D" & Rows.Count).End(xlUp).Row)
End With
    For Each c In rng
        If (Application.CountIf(rng, c.Value) >= 2) Then c.EntireRow.Interior.ColorIndex = 3
    Next c
End Sub

[missy22]

Thank you for updating the code. The macro works great.
Thank you very much for all your help and time.