VBA Auto Generate Unique IDs

[natekris8183]

I have probably read 30+ postings on the topic. Most of them typically revolve around creating a Public Function, and that's not my goal. I don't want to create a function to use within a cell, I need the Sub to run through a user form. I have a Userform to create a new account, and need to add a 6 digit unique identifier after a predetermined prefix ("T" for toddler, "Y" for youth, and "A" for adult). The constraints are that it cannot be duplicated (this is for multiple children registered within the company). I have tried using the GUID but having difficulty stripping characters and adding the prefix (this was my fix inclination). I don't want anyone to have to recreate the wheel, so IF there is something I have yet to stumble across, my apologies and please point me in that direction. Thank you.

 

[MickG]

Try this:-
Your Userform should have 3 Option Buttons named "CHILD", "TODDLER" and "YOUTH" and a command button.
Cell "A1" need the header "ID" in it.(or similar)
Place this code in the Command Button
When the userform shows. Select "Option Button". Click Command Button and Unique number with related prefix start in "A2"

Private [COLOR=Navy]Sub[/COLOR] CommandButton1_Click()
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] pType [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] oMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Const StartNum = 1000000
[COLOR=Navy]For[/COLOR] n = 1 To 3
[COLOR=Navy]With[/COLOR] Me.Controls("OptionButton" & n).Object
    [COLOR=Navy]If[/COLOR] .Value = True [COLOR=Navy]Then[/COLOR]
        pType = Left(.Caption, 1)
        [COLOR=Navy]Exit[/COLOR] For
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] pType = vbNullString [COLOR=Navy]Then[/COLOR] MsgBox "Please [COLOR=Navy]Select[/COLOR] Option Button": [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]


[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
[COLOR=Navy]If[/COLOR] Left(Dn.Value, 1) = pType [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
       .Add Dn.Value, Mid(Dn, 2)
    oMax = Application.Max(.Item(Dn.Value), Mid(Dn, 2))
    [COLOR=Navy]Else[/COLOR]
        MsgBox "Number Exists:-" & Dn.Value
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] .Count = 0 [COLOR=Navy]Then[/COLOR]
    Range("A" & Rng.Count + 1) = pType & StartNum
[COLOR=Navy]Else[/COLOR]
    Range("A" & Rng.Count + 1) = pType & oMax + 1
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[Rick Rothstein]

I have probably read 30+ postings on the topic. Most of them typically revolve around creating a Public Function, and that's not my goal. I don't want to create a function to use within a cell, I need the Sub to run through a user form. I have a Userform to create a new account, and need to add a 6 digit unique identifier after a predetermined prefix ("T" for toddler, "Y" for youth, and "A" for adult). The constraints are that it cannot be duplicated (this is for multiple children registered within the company). I have tried using the GUID but having difficulty stripping characters and adding the prefix (this was my fix inclination). I don't want anyone to have to recreate the wheel, so IF there is something I have yet to stumble across, my apologies and please point me in that direction. Thank you.

Any chance you can use a 12-digit number? If so, just use the current date/time down to the second...

Unique = "T" & Format(Now, "mmddyyhhnnss")

 

[JLGWhiz]

To ensure integrity of the unique character assignment, you would need some form of register to use as a control of the number assignment. I have a program where I use a range to record the last assigned number and then use an alpha character to precede the number set by concatenation. The process is relatively simple, when it needs a new unique number, it looks at the register, adds one to that number, then concatenates to the alpha character. Assuming the register is Cell XYZ1.

Dim myDocNbr As String
'Assume Toddler-assumed to be controlled elsewhere in the code, the "T"
'would most likely be in the form of a variable.
myDocNbr = "T" & Range("XYZ1") + 1
Range("XYZ1") = Range("XYZ1").Value + 1

You can format the register cell as text if you want to use zero fill left, but if you do not anticipate exceeding 900,000 document numbers, it might be easier to stard with 100000 in the register.

 

[natekris8183]

Mick~ It functions quite well, however it there are a couple of minor complications ( I can fix and have fixed one ). I prefer using tables over areas for simplicity of building reports, so I am will have an "ID" column, instead of a named range ( essentially the same thing ). Unfortunately the first creation of an ID for each individual area overwrites the other if it doesn't exist. Meaning if I create the first Youth account it overwrites the first Toddler or Child account if by chance there isn't one. This is the one that's an easy fix for a control If statement to check to see if there is a "T" value in the column and if not to xlDown + 1 to the area below the last entry (next blank cell). The problem I am having is that it's only adding one integer to the Prefix, whereas I need to have (or would prefer to have) a unique 6-digit account number attached to the prefix. Rick, 12 would be a little overkill considering there's typically less than 100 dancers in any given year. The books will be closed out annually and new IDs created for the next dance year. I am not really keen on the increasing the number by one, as it's not really "unique". The sequential ordering can get confusing when looking at it from a bookkeeping standpoint, when everything follows that sequentially. If the accounts followed at T1, T2, & T3, that could be easily confused with Y1, Y2, & Y3... versus T285603, T864013, T8436791. Make sense?

 

[MickG]

I have change the start Number constants, to make them more Individual , as you will see from the code, Change as required.

Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] pType [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] StartNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Const aNum = 1111111
Const yNum = 4444444
Const tNum = 8888888
[COLOR="Navy"]For[/COLOR] n = 1 To 3
[COLOR="Navy"]With[/COLOR] Me.Controls("OptionButton" & n).Object
    [COLOR="Navy"]If[/COLOR] .Value = True [COLOR="Navy"]Then[/COLOR]
        pType = Left(.Caption, 1)
        [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] pType = vbNullString [COLOR="Navy"]Then[/COLOR] MsgBox "Please [COLOR="Navy"]Select[/COLOR] Option Button": [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] pType
[COLOR="Navy"]Case[/COLOR] "A": StartNum = aNum
[COLOR="Navy"]Case[/COLOR] "Y": StartNum = yNum
[COLOR="Navy"]Case[/COLOR] "T": StartNum = tNum
[COLOR="Navy"]End[/COLOR] Select
 
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Left(Dn.Value, 1) = pType [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
       .Add Dn.Value, Mid(Dn, 2)
    oMax = Application.Max(.Item(Dn.Value), Mid(Dn, 2))
    [COLOR="Navy"]Else[/COLOR]
        MsgBox "Numer Exists:-" & Dn.Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] .Count = 0 [COLOR="Navy"]Then[/COLOR]
    Range("A" & Rng.Count + 1) = pType & StartNum
[COLOR="Navy"]Else[/COLOR]
    Range("A" & Rng.Count + 1) = pType & oMax + 1
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[natekris8183]

This is still somewhat what I am looking for but not precisely. I have opted to just use the Evaluate function in the vba with a concatenate with the appropriate prefix with a conditional If statement dependent upon the radio button selected, and a control loop to verify the number doesn't exist and if it does to randomize another 6 digit number. This code is significant shorter as well. I'll post once I have tested for any Null values, although I can't imagine there'd be any. Thanks for all the help.

 

[natekris8183]

Just some slight modifications, but this ended providing the solution I needed. Thanks ALOT Mick, you were a HUGE help!

Private Sub CommandButton1_Click()
Dim rng As Range, Dn As Range, n As Long
Dim pType As String
Dim oMax As Long
Dim StartNum As Long
Set rng = Range("Table1[ID]")
aNum = Evaluate("=RANDBETWEEN(100000,999999)")
yNum = Evaluate("=RANDBETWEEN(100000,999999)")
tNum = Evaluate("=RANDBETWEEN(100000,999999)")
For n = 1 To 3
With Me.Controls("OptionButton" & n).Object
    If .Value = True Then
        pType = Left(.Caption, 1)
        Exit For
    End If
End With
Next
If pType = vbNullString Then MsgBox "Please Select Option Button": Exit Sub
Select Case pType
Case "C": StartNum = aNum
Case "Y": StartNum = yNum
Case "T": StartNum = tNum
End Select
With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
For Each Dn In rng
    If Left(Dn.Value, 1) = pType Then
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Mid(Dn, 2)
        oMax = Application.Max(.Item(Dn.Value), Mid(Dn, 2))
    Else
        MsgBox "Numer exists:-" & Dn.Value
    End If
End If
Next
If Range("A2") = 0 Then
    Range("A2") = pType & StartNum
Else
    Range("A1").Offset(rng.Rows.Count + 1) = pType & StartNum
End If
End With
Unload Me
End Sub

 

[natekris8183]

For anyone following this thread, this is was the final VB code written if you care to use it for anything. It designed so that no matter how many option buttons placed on the userform it will work.

Private Sub CommandButton1_Click()
Dim rng As Range, Dn As Range, n As Long
Dim pType As String
Dim oMax As Long
Dim StartNum As Long
Dim cCount As Control
Set rng = Range("Table1[ID]")
iNum = Evaluate("=RANDBETWEEN(100000,999999)")
iOB = 0
iOB2 = 0
For Each cCount In Me.Controls
    If TypeName(cCount) = "OptionButton" Then
        iOB = iOB + 1
    End If
Next
For n = 1 To iOB
With Me.Controls("OptionButton" & n).Object
    If .Value = True Then
        pType = Left(.Caption, 1)
        Exit For
    Else
        If .Value = False Then
            iOB2 = iOB2 + 1
            If iOB2 = iOB Then
                MsgBox "Please select age group"
                Exit Sub
                Exit For
            End If
        End If
    End If
End With
Next
pType = pType & iNum
With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
For Each Dn In rng
    If Left(Dn.Value, 1) = pType Then
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Mid(Dn, 2)
        oMax = Application.Max(.Item(Dn.Value), Mid(Dn, 2))
    Else
        MsgBox "Numer exists:-" & Dn.Value
    End If
End If
Next
End With
Me.TextBox1 = pType
End Sub