Sub test()
Dim a, i As Long
With Range("a1").CurrentRegion.Resize(,2)
a = .Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a,1)
If Not IsEmpty(a(i,2)) And Not .exists(a(i,2)) Then .add a(i,2), Nothing
Next
For i = 1 To UBound(a,1)
If .exists(a(i,1)) Then a(i,1) = ""
Next
End With
.Value = a
End With
End Sub