Excel VBA assign unique ID to data set

[nitrammada]

Hi Folks,

I'm setting up a spread sheet that will ultimately have up to 10,000 records in it.
I need to assign a unique ID to each row. I don't want to use a formula with "+1" as I will have to delete rows and add rows from time to time and I need the ID to remain constant(unique) to that row of data. I don't want to use autofill and then cut and paste into an adjacent column. So i figure I will need to use VBA. Let's say my unique ID number is in column B, I need to be able to insert a row anywhere in my spread sheet and for a unique ID number to populate the cell in column B. The code will need to search for the highest ID number in column B (the ID will be a number) and then assign the next highest number in column B in the row I have just inserted. Does that make sense? Can anyone help me with this? I'm not very proficient with VB (dummy actually) so if you have any code I could use I would be most grateful. I'm using Windows 10, 64 bit

Thanks in advance

Adam

 

[MickG]

Try this "Change_Event"
To load Code:- Right click Sheet Tab, Select "View Code", Vbwindow appears, Paste code in Vbwindow, Close vbwindow.
Run code by inserting a Row within Column "B" Range of Numbers.

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False
    [COLOR="Navy"]If[/COLOR] Target.Rows.Count = 1 And Cells(Target.Row, "B") = "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]If[/COLOR] Not Intersect(Target, Rng) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
       Cells(Target.Row, "B") = Application.Max(Rng) + 1
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[nitrammada]

Hello Mick,

Your a champion, it works perfectly when I enter a new row, thank you so much.
I wonder if I could prevail upon your expertise a little further. When I enter new data at the end of the table, so I'm not inserting a new row here I'm just adding on to the existing table, how can I get that same unique ID to populate automatically?
I guess it will be dependent on the adjacent fields being populated to trigger something to insert a unique ID, but I'm not sure how to do that.
Sorry to trouble you.

Regards
Adam

 

[MickG]

This code should now also add next number to list in column "B" when a value is placed in the next empty row after the last unique number in column "B"

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False
    [COLOR="Navy"]If[/COLOR] Target.Rows.Count = 1 And Cells(Target.Row, "B") = "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
    
    [COLOR="Navy"]If[/COLOR] Not Intersect(Target, Rng) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
       Cells(Target.Row, "B") = Application.Max(Rng) + 1
    [COLOR="Navy"]ElseIf[/COLOR] Not Intersect(Target, Rng(Rng.Count + 1).EntireRow) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
       [COLOR="Navy"]If[/COLOR] Rng(Rng.Count + 1).Value = "" [COLOR="Navy"]Then[/COLOR] Rng(Rng.Count + 1) = Application.Max(Rng) + 1
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[nitrammada]

This code should now also add next number to list in column "B" when a value is placed in the next empty row after the last unique number in column "B"

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range
Application.EnableEvents = False
    [COLOR=Navy]If[/COLOR] Target.Rows.Count = 1 And Cells(Target.Row, "B") = "" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
    
    [COLOR=Navy]If[/COLOR] Not Intersect(Target, Rng) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
       Cells(Target.Row, "B") = Application.Max(Rng) + 1
    [COLOR=Navy]ElseIf[/COLOR] Not Intersect(Target, Rng(Rng.Count + 1).EntireRow) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
       [COLOR=Navy]If[/COLOR] Rng(Rng.Count + 1).Value = "" [COLOR=Navy]Then[/COLOR] Rng(Rng.Count + 1) = Application.Max(Rng) + 1
    [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hi Mick,

Brilliant, thank you again. It works a treat and just what I needed, appreciate your time and willingness to help.

regards Adam

 

[nitrammada]

Hello Mick,
Sorry to bother you again, I just realized due to the fact that I have multiple columns to the right of my data that are formatted in a certain way, on occasion I will want to copy the entire row from above to the row below and hence keep the formatting of columns to the right of my spreadsheet. Is it possible to do this and create a unique ID for the new row as your code does when inserting a row?
Regards
Adam

 

[MickG]

Try this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False
  [COLOR="Navy"]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]If[/COLOR] Target.Rows.Count = 1 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] True
            [COLOR="Navy"]Case[/COLOR] Target.Row <= Rng.Count: Cells(Target.Row, "B") = Application.Max(Rng) + 1
            [COLOR="Navy"]Case[/COLOR] Target.Row = Rng.Count + 1: Cells(Target.Row, "B") = Application.Max(Rng) + 1
            [COLOR="Navy"]Case[/COLOR] Cells(Target.Row - 1, "B") = Cells(Target.Row, "B") = Cells(Target.Row, "B") = Application.Max(Rng) + 1
        [COLOR="Navy"]End[/COLOR] Select
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[nitrammada]

Hello Mick,

Thank you, it's nearly there.
Inserting a row still works fine, the ID number increases by 1, perfect. But the copy line procedure increases the ID number by 2.
I was looking at your code to try and figure it out myself but it is a little beyond me. Any suggestions?

Regards
Adam

 

[MickG]

Are you sure, I can't replicate that.!!
Copying a line to the next clear line down results in a new number (max of column "B" +1)

 

[nitrammada]

OK, got it Mick, thank you. I was using the mouse right click fly out menu "Insert copied cells" and getting the ID jumping by 2, if I use Ctl+V no problem as you say, I can work with that no problems, thank you again for you time and patience.
Regards Adam