Text Manipulation

I believe that this macro will do what you want. If works by scanning down the column from top to bottom looking if it has seen the substring before.

Sub Test()
CurrentID = 0
For N = 2 To Cells(65536, 1).End(xlUp).Row
If Application.CountIf(Range(Cells(2, 1), Cells(N, 1)), Cells(N, 1) & "*") > 1 Then
Cells(N, 2) = Range(Cells(2, 1), Cells(N - 1, 1)).Find(Cells(N, 1), Cells(2, 1), xlValues, xlPart).Offset(0, 1)
Else
CurrentID = CurrentID + 1
Cells(N, 2) = CurrentID
End If
Next N
End Sub