Option Explicit
Sub abc()
Dim i, d
Set d = CreateObject("scripting.dictionary")
For i = [a1].End(xlDown).Row To 1 Step -1
d(Cells(i, "a").Value) = d(Cells(i, "a").Value) + 1
Next
For i = [a1].End(xlDown).Row To 1 Step -1
If d(Cells(i, "a").Value) = 1 Then
Cells(i, "b") = "no"
ElseIf d(Cells(i, "a").Value) > 1 Then
Cells(i, "b") = "yes"
d(Cells(i, "a").Value) = 0
Else
Cells(i, "b") = Empty
End If
Next
End Sub