Add unique Id to list of numbers - VBA

Question

I have a list of numbers (50,000+) and I need to add a Id to the end of each unique group. The Id is in a format of "-###".

151022
151022
151020
150922
150715
150911
151014
151021
151020
151019
151019
151019
151020

I need it to print like this

151022-001
151022-002
151020-001
150922-001
150715-001
150911-001
151014-001
151021-001
151020-002
151019-001
151019-002
151019-003
151020-002

I currently have this code that I found and modified slightly. If I could get it to start counting unique values at -002 then I believe that would solve it.

Option Explicit

Sub test()
    Dim uniqueCounter As New Scripting.Dictionary
    Dim counter As Long
    Dim rowCount As Long
    Dim identifer As String


    rowCount = ActiveCell.CurrentRegion.Rows.Count 'Whatever code you want to put in to calculate the last row

    For counter = 1 To rowCount
        identifer = Sheet1.Cells(counter, 1) 'Put whatever number of combination of cells which the row unique here (maybe it's just the one)
        If uniqueCounter.Exists(identifer) Then
            uniqueCounter(identifer) = CLng(uniqueCounter(CStr(Sheet1.Cells(counter, 1)))) + 1
            Sheet1.Cells(counter, 2) = identifer & "-00" & uniqueCounter(CStr(Sheet1.Cells(counter, 1)))
        Else
            uniqueCounter.Add identifer, "0"
            Sheet1.Cells(counter, 2) = identifer
        End If
    Next counter

End Sub

This what it currently displays:

151022  151022
151022  151022-001
151020  151020
150922  150922
150715  150715
150911  150911
151014  151014
151021  151021
151020  151020-001
151019  151019
151019  151019-001
151019  151019-002
151020  151020-002

Thanks All!

Answer 1

I know you asked for vba, but a simple formula will give you the desired output.

In B1 put:

=A1& "-" &TEXT(COUNTIF($A$1:A1,A1),"000")

And copy down the extent of the data.

---

If you want it in vba; I would do something like this:

Sub test2()
    Dim rng As Range
    Dim rngcnt As Range
    Dim firstrow As Long
    Dim lastrow As Long
    Dim columnNumber As Long
    Dim ws As Worksheet

    Set ws = Worksheets("Sheet15") 'change to your sheet
    firstrow = 1 'change to your first row of data
    columnNumber = 1 'change to the column number

    With ws
        lastrow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
        For i = firstrow To lastrow
            .Cells(i, columnNumber + 1) = .Cells(i, columnNumber) & "-" & Format(Application.WorksheetFunction.CountIf(.Range(.Cells(firstrow, columnNumber), .Cells(i, columnNumber)), .Cells(i, columnNumber)), "000")
        Next i
    End With

End Sub

Which effectively does the same as the above formula.