Sub test_2()
Dim I&, D As Object
Set D = CreateObject("Scripting.dictionary")
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Sheet1")
For I = .Cells(.Rows.Count, 1).End(3).Row To 1 Step -1
If CLng(Replace(.Cells(I, 3).Value, ".", ",")) * 1 = 0 Or D.Exists(.Cells(I, 2).Value) Then
If Err Then
Err.Clear
.Cells(I, 3).Interior.ColorIndex = 3
Else
.Rows(I).Delete
End If
Else
D(.Cells(I, 2).Value) = ""
End If
Next I
End With
End Sub