How to add unique serial numbers using VBA code

Question

There are some values in column B (ex. Employee numbers). Few numbers are repeated. I want to give unique serial number to each unique employee id. Like for employee A number 1, employee B- 2, if A comes again in next cell then again give serial number as 1. I tried with below code, please help. Code:

Sub add_serial_number()
    Dim i As Long
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(i, "B").Value <> "" Then
            Cells(i, "A").Value = i - 1
        End If
    Next i
End Sub

Answer 1

I've done it quick, adapted the code i found here and had to think about it also, and also used a 'trick', but i think this is what you want. Its given me your desired results.

Sub add_sbFindDuplicatesInColumn5()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("B65001").End(xlUp).Row 'changed it to +1 of the lookup range to catch all values .

For iCntr = 1 To lastRow

If Cells(iCntr, 2) <> "" Then
    
       
    matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
    
    If iCntr = matchFoundIndex Then
        Cells(iCntr, 1).Value = iCntr - 1
        
       Else:
          Cells(iCntr, 1) = "Duplicate - " & WorksheetFunction.Index(Range("A1:A65000"), WorksheetFunction.Match(Cells(iCntr, 2).Value, Range("B1:B65000"), 0))

    'delete "Duplicate - " & in your case if you chose to do with it. it wont be neccissary. Was for testing.

    End If
End If


Next
End Sub

I say "used a trick", because I think I should have stored the duplicates and their Id's in their own array , which is what I think you "should" do for a proper working answer and run check against them and assign the relevant values that way. Instead what I'm doing (due to time constraints I had) - is looking them up with an index match WorksheetFunction. But I think now im going around in circles and this is what excel was built for . The code seems to be exactly what you want. Does the job. Only question is how will it fare over 20k rows and your 8GB ram?

In any case, for my data, Everyone gets a unique id unless they are a duplicate, where they get the original first instance of the duplicate values id.

Its Worked for me . Does it work for you ? I think my answer is the most logical/simplest one, you don't even need any special order in your data & its the quickest dish up for a solution for you I could do in the half an hour that I had on it (minus that array idea). Let me know.

Oh no. It does get every duplicate and assign ids to all values except the last one, because the lookup ofcourse doesn't find any more below it. I'm in bed now going to bed and will try to make it work for that last bit aswell tomorrow .

Ok. I think I solved that problem too for the range. Just make sure your last row has 1 more row than your lookup ranges. It will then catch everything in that range (IDs & dup's). If someone has a more elegant, generically applicable (& less hard coded) solution for this please let me know.

Answer 2

By Hook or By Crook I got it working. Got what you wanted , and did so without dictionary's, without using Arrays, dictionaries or keys (which would be a better way I feel but too much headache for me right now). Must understand I am smashed, the area I live in is driven me insane and need a holiday.

it was done the "cheat" way (by VBA worksheetFormulas - which is no cheat but just what I think) and not the Arrays/Dictionaries I was looking at Here, Here and Here , its less generic and less stable I feel, so you must clear column A each time you run otherwise some the id's will +1 each time, and if you add a value in between others, the id's will change. So really this is only good for getting the ID's first time, saving and for any new ones you add, unless they are below all the others. will change the id's. ONLY ADD NEW VALUES BELOW OTHERS IN THE LIST , NOT IN THE MIDDLE (OTHERWISE IT STILL WORKS, BUT YOULL LOOSE (CHANGE) SOME OF THE ID'S , YOULL END UP CHANGING THEM IF YOU ADD NEW VALUES AND RUN ANYWHERE ELSE OTHER THEN AT THE END OF THE LAST ENTRY/ VALUE)

So if you actually not adding value in order, and adding them somewhere in the middle, yes they will still get an id (as will all the others) but these id's wont be stable (they might not be the same as before).

ERGO: Yes, Dictionary Array would be much better (and faster) ergo please ensure you add in order (below the last entry with or without Blank cells - those dont matter) and not in the middle otherwise on the 2nd and 3rd run of doing that youll change some of the id's . Good for 1 time use and then a save, Also good for adding entries in order, but Bad for adding entries wherever you want in the column which will change the ID's (although still create correct ones for that instance). Maybe that's what you want? the id's will change depending what you do.

Sub add_my_serial_numbers()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

Range("A:A").Cells.Clear 'Very Important if your going to be using this code to make your serial #'s. For the process/code to work properly, the serial numbers must be cleared everytime you run. its part of the process and ensures it works.

lastRow = Range("B65001").End(xlUp).Row 'changed it to +1 of the lookup range to catch all values .

For iCntr = 1 To lastRow

If Cells(iCntr, 2) <> "" Then
    
    matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
    
    arr = Array(matchFoundIndex)
    
    If iCntr = matchFoundIndex Then
       If WorksheetFunction.CountIf(Range("B1:B" & lastRow), Cells(iCntr, 2)) = 1 Then
       Cells(iCntr, 1).Value = WorksheetFunction.Max(Range("A1:A" & iCntr - 1)) + 1
       Else
       
        Cells(iCntr, 1).Value = WorksheetFunction.Max(Range("A1:A" & iCntr)) + 1

        End If
       
       Else:
       
          Cells(iCntr, 1) = WorksheetFunction.Index(Range("A1:A65000"), WorksheetFunction.Match(Cells(iCntr, 2).Value, Range("B1:B65000"), 0))

    'delete "Duplicate - " & in your case if you chose to do with it. it wont be neccissary. Was for testing.
     'warning this code will not work the same or at all with strings so removed deletes which where unneccisary anyway.

    End If
End If

Next
End Sub

/ Really can't see straight anymore to concentrate on it . Was the whole area and naighbours , 100s of them& the music . I need to eat .

But it seems to be working as you want need it .

add-unique-number-to-excel-datasheet-using-vba

add-unique-id-to-list-of-numbers-vba

quicker-way-to-get-all-unique-values-of-a-column-in-vba

get-the-nth-index-of-an-array-in-vba

using dictionaries youtube

Very Good Video by Leila Gharani

vba-how-do-i-get-unique-values-in-a-column-and-insert-it-into-an-array

how-to-extract-a-unique-list-and-the-duplicates-in-excel-from-one-column

All excellent reading above, all related to what I was reading and tried (but gave up) . But dicts are the way to go for this .

& Pity you & I dont have Office 365, you could have easily used its Unique Function to help you do it. (but even if they gave it to me, I don't think id like it. Its too "app-y").

Extract-unique-values-in-excel-using-one-function.html

Here is screen shot of my data after I ran the code (which works).

In all, its a trick way of creating ids on a spreadsheet . It's not great code. Not the best at all (Dictionary's and Keys would be best). Nor the fastest, doesn't assign these IDs back end to any storage , and neither does it set them in stone (which is what you'd want ideally for creating ids), but it does give you the functionality of creating working "ids" on your working spreadsheet as your working (i.e. gives you what you requested for the time being atleast. Good for working spreadsheets with similar reqs).

Once you create them using my code you can pass them to an array (very easy) with the rows and columns they relate to with another sub , and do more stable work with them going forward. But it holds up and works quite well as it is/for what it was designed for.

you can also see my testing . image 3..Col I: my unique values from Column B, Col J: the countif's of these in B, and in Col H: the nth number in the list/the order they appear.