Case sensitive duplicate numbering

How about

Sub Number()
Dim rCell As Range, rSource As Range
Set rSource = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

With CreateObject("scripting.dictionary")
   For Each rCell In rSource
      If rCell.Value = "**" Then .removeall
      .Item(rCell.Value) = .Item(rCell.Value) + 1
      rCell.Offset(0, 1).Value = .Item(rCell.Value)
   Next
End With
End Sub