ScreenUpdating = False
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
Do While ActiveCell < ""
If FirstItem = SecondItem Then
ActiveCell.Offset(Offsetcount, 4).Interior.Color = RGB(255, 0, 0)
ActiveCell.Offset(Offsetcount, 4).Value = "dup"
Offsetcount = Offsetcount + 1
SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
Else
ActiveCell.Offset(Offsetcount, 0).Select
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
End If
Loop
ScreenUpdating = True
End Sub

Try this I changed the offset count to 4 (four columns to the right) and
entered another line of text (ActiveCell.Offset(Offsetcount, 4).Value =
"dup") which adds the word dub if the value is duplicated.
You can then used the auto filter function to filter / delete duplicated
values.