Try this:

Code:
Sub Partho(): Dim r As Long, N As String, K
With CreateObject("scripting.Dictionary")
For r = 2 To Range("B" & Rows.count).End(xlUp).Row
If Cells(r, 2) <> "" Then
N = Trim(Cells(r, 2)): .Item(N) = r: End If: Next r
K = .Keys(): For r = LBound(K) To UBound(K)
                Cells(.Item(K(r)), 4) = 1: Next r
End With: End Sub