Macro - count duplicates, append cell with the count sequence

overclock

New Member
Joined
May 24, 2019
Messages
12
Office Version
  1. 365
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

smozgur

BatCoder
Joined
Feb 28, 2002
Messages
1,270
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:
VBA Code:
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

New Member
Joined
May 24, 2019
Messages
12
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,418
Messages
5,596,028
Members
414,039
Latest member
southike

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top