making duplicate cells unique by adding counter

Topic

New Reply

I have a large spreadsheet with two columns. The second column contains a lot of duplicates. I would like to add a counter to each duplicate cell, thus making each unique.

The current contents of the cells in column two are, say:

abcd
abcd
abcd

I would like to end up with:

abcd
abcd-1
abcd-2

If I were a programmer, I would write a macro that loops through the spreadsheet, finds the duplicate cells and adds a counter to each, until all cells were unique. Unfortunately I can’t write such code.

I would be very grateful if someone could help me.

Regards
useful

Reply | Quote

Replies

U,

This code will add the counter as you described to the duplicates.

Hope you find it useful, Useful.

Maud

34394-Counter1 34395-Counter2

Code:

Public Sub AddCounter()
LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row  [COLOR=”#008000″]’FIND LAST ROW[/COLOR]
counter = 1
For I = 2 To LastRow  [COLOR=”#008000″]’CYCLE THROUGH ALL VALUES[/COLOR]
    base = Cells(I, 2).Value  [COLOR=”#008000″]’GET BASE VALUE[/COLOR]
    For K = I + 1 To LastRow  [COLOR=”#008000″]’CYCLE THROUGH REMAINING VALUES[/COLOR]
        compare = Cells(K, 2).Value  [COLOR=”#008000″]’GET VALUE TO COMPARE TO BASE[/COLOR]
        If base = compare Then  ‘[COLOR=”#008000″]IF MATCH THEN…[/COLOR]
            Cells(K, 2).Value = compare & “-” & counter  [COLOR=”#008000″]’ADD THE COUNTER[/COLOR]
            counter = counter + 1  [COLOR=”#008000″]’INCREMENT COUNTER[/COLOR]
        End If
    Next K
    counter = 1  [COLOR=”#008000″]’RESET COUNTER[/COLOR]
Next I
End Sub

Reply | Quote

Hi Maud

Thank you for the prompt response and the code. You are wonderful, writing code that doesn’t even require the column sorted to have all the duplicates together in sequence.

Thank you for enabling me to be useful.

Regards
useful

Reply | Quote

Useful,

You were right on the money with the logic to do it!

Reply | Quote