Macro - count duplicates, append cell with the count sequence

[overclock]

I have a column of ID numbers that I converted to six digits, some with leading zeros, that is stored as text. What I would like to do is have a macro look for duplicate values and append the text in the cell with the sequence number of the duplicate. So this:

000123

000124

000124

945125

945125

would show as:

00123

000124-1

000124-2

945125-1

945125-2

I have search for hours and tried several macros but I can't find anything that gives these results. I can sometimes modify code to accomplish my goals but I am stumped on this one.

Thank you for your help.

 

[smozgur]

Why 000123 doesn't show as 000123-1 but 00123 - not even equal to original value? Do you need to use original values if there is no duplicate value? (I am ignoring the fact that it is not even equal to 000123 assuming it is just a typo but let us know if there is a specific rule for that too).

I would think something like this:

Sub doIt()
Dim rng As Range
Dim cll As Range
Dim strProcessed As String
Dim strTemp As String
Dim i As Integer
   
    ' Select the range to process
    ' This is just a sample, so using the selection
    ' to keep the code simple
    Set rng = Selection
   
    ' Need to sort.
    ' If original sort should stay then
    ' add a temporary column to keep index key
    ' to apply original sort when this is done
    rng.Sort rng.Cells(1, 1)

    For Each cll In rng.Cells
        ' Using a variable to keep processed cell value
        ' to compare with the current cell value
        ' Restart numbering if processed one
        ' is not the same value with the current cell value
        If strProcessed <> cll.Value Then
            i = 1
        End If
       
        ' Temporarily add index number
        ' because we might need to remove it
        ' if there is only one
        strTemp = cll.Value & "-" & i
       
        ' If next cell is the same value
        ' then increment the index number
        If cll.Value = cll.Offset(1).Value Then
            i = i + 1
        End If
       
        ' If there is only one of this value
        ' then do not add -1 but keep the original value
        If i = 1 Then
            strTemp = cll.Value
        End If
       
        ' Set the processed value to compare next
        strProcessed = cll.Value
       
        ' Write the generated value
        ' into the adjacent cell
        ' Remove .Offset( ,1) to overwrite the original cell
        cll.Offset(, 1).Value = strTemp
    Next cll
End Sub

 

[overclock]

Thank you for your reply. This is very close to what I need. Yes, I need the original values if there is not a duplicate. I need to rename timesheets to the employee IDs. There may be an occassion, although not preferable, where there are two timesheets for the same employee ID. The code I have so far imports a list of files from a folder, extracts the first six characters of the filename that represents the employee ID, then converts the numbers back to six digits and adds back the leading zeroes if they were dropped during the extract. Now I need to update the cells that have duplicates. The next steps add ".pdf" to the six digit field. Several macros I found got close to what I needed but they would number the instances of occurrence after the first but not number the first.