# Generate a unique code

Does anybody have a good function that generates a unique code for a primary key field?

Maybe generated from the current time and date?

I dont want people to be able to guess the number (or the way it works).

Using autonumber is no good, I need a key that will be hard to guess, for example:

current time/date in miliseconds - or something like that?

the code shouldn't be more than 11 digits long.

thanks!!
LVL 1
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
You could use code like this..

Dim sValue As String
Dim a As Integer

Randomize

sValue = Space\$(11)
For a = 1 To 11
Mid\$(sValue, a, 1) = Chr\$(Int(Rnd * 255) + 1)
Next

Me.Caption = sValue

The Randomize statement make sure the random numbers are random, using the current Time to calculate the first random number.

Another solution would be to create GUID's (Globally Unique Identifier), unique numbers that are achieved by using a combination of the current time, your machine's Media Access Control (MAC) address (a unique number built into all network cards) if it has one, and other routines. You can read more about these GUID's AND get free source code from...

http://www.vbaccelerator.com/codelib/tlb/guid.htm
0
Commented:
Maybe you could use this function i wrote to generate a 14 digits code (you may want to trim de code by removing some variable 'Sect' in the returned value) It's based on the current date et time and then encoded :

Function GENERATE_CODE()
Dim DATEHEURE
Dim DHTMP
Dim sec As Integer
Dim Tmp1 As String
Dim TMP2 As String
Dim tmp3 As String
Dim Tmp4 As String
Dim Tmp5 As String
Dim Tmp6 As String
Dim Tmp7 As String
Dim Sect1 As String
Dim Sect2 As String
Dim Sect3 As String
Dim Sect4 As String
Dim Sect5 As String
Dim Sect6 As String
Dim Sect7 As String

Dim bid1, bid2 As String
Dim Tempo, Tempo_Octal As String

DHTMP = Now

DATEHEURE = Format\$(Day(DHTMP), "00") & Format\$(Month(DHTMP), "00") & Format\$(Year(DHTMP), "0000") & Format\$(Hour(DHTMP), "00") & Format\$(Minute(DHTMP), "00") & Format\$(Second(DHTMP), "00")

GCOMPAR = DATEHEURE

Tmp6 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 13, 2)) + 3), "00")
sec = Val(Right\$(Tmp6, 1))
Tmp1 = Format\$(Str\$((Val(Mid\$(DATEHEURE, 1, 2)) * 2) + sec), "00")
TMP2 = Format\$(Str\$((Val(Mid\$(DATEHEURE, 3, 2)) * 3) + sec + 1), "00")
'tmp3 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 5, 2))), "00")
'Tmp7 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 7, 2))), "00")
Tmp4 = Format\$(Str\$((Val(Mid\$(DATEHEURE, 9, 2)) + sec) * 3), "00")
Tmp5 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 11, 2)) + sec + 1), "00")
Tempo = Format\$(Str\$(Val(Mid\$(DATEHEURE, 5, 4))), "00")
Tempo_Octal = Oct(Tempo)     'Année en octal
bid1 = Left(Tempo_Octal, 2)  'Deux premier chiffre de l'année, en octal
bid2 = Right(Tempo_Octal, 2) 'Deux dernier chiffre de l'année, en octal
tmp3 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 9, 2)) + Val(bid1)))
Tmp7 = Format\$(Str\$(Val(Mid\$(DATEHEURE, 1, 2)) + Val(bid2)))

Sect1 = Right\$(Tmp1, 1) & Left\$(Tmp1, 1)
Sect2 = Right\$(TMP2, 1) & Left\$(TMP2, 1)
Sect3 = Right\$(tmp3, 1) & Left\$(tmp3, 1)
Sect4 = Right\$(Tmp4, 1) & Left\$(Tmp4, 1)
Sect5 = Right\$(Tmp5, 1) & Left\$(Tmp5, 1)
Sect6 = Right\$(Tmp6, 1) & Left\$(Tmp6, 1)
Sect7 = Right\$(Tmp7, 1) & Left\$(Tmp7, 1)

GENERATE_CODE =  Sect5 & Sect1 & Sect3 & Sect2 & Sect4 & Sect6 & sect7

End Function

0

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Commented:
I usually just pick certain characters from other fields pertaining to the record using mid right and left functions.
IE.
field sfname Wayne
field slname Visual
field Bday   02121970
field sphone 8122125554

pseudo

uniquefield = left(sfname,2) & right(slname,3) & mid(bday,3,2) & mid(sphone,5,4)

unique field = waual122125

lots of combinations to come up with
you could also put your date and time etc...up to you...also you should put an error code in..if duplicate then replace certain characters with a Z or whatever.

Hav fun
0
Author Commented:
thanks,

but people will need to type in the code to gain access to a computer.

so i need it to be number and letter only and not too long like the GUID's

:)
0
Commented:
If you want it to be a numeric value you can use

Dim lValue As Long
Dim a As Integer

Const MinValue = 100000000
Const MaxValue = 999999999

Randomize

lValue = Int(Rnd * (MaxValue - MinValue + 1)) + MinValue

Me.Caption = lValue

I have added two constants here so you can easily set the minimum value you want and the maximum value. If you want it to be bigger than 2*10^9 you will have to define the lValue variable as a Double or something
..
0
Commented:
If the GUID is too long, there is nothing stopping you from just using a part of the value, for example only the Data1 (Long variable) part of the UDT.

0
Commented:

Have you though about using checksum?'get a checksum from a name
'<<<  general declarations  >>>
'
Option Explicit

Function GetChecksum(Source As String) As Long
Dim iVal, Weight, CheckHold, CheckSum As Long
Weight = 1
CheckSum = 0
For iVal = 1 To Len(Source)
CheckHold = Asc(Mid\$(Source, iVal, 1)) * Weight
CheckSum = CheckSum + CheckHold
Weight = Weight + 2
Next iVal
GetChecksum = CheckSum Mod &H7FFFFFFF
End Function

' <<<<<<<<<<<< form event code >>>>>>>>>>>>

Private Sub Command1_Click()
Dim x\$
x = "John Wayne"
MsgBox GetChecksum(x)
End Sub

0
Author Commented:

I have given the points to freg - I just hope that the code generates a unique number each time - but that is easy to check for.

I'm sure it is a problem many people will have for password generation when you don't know much infomation about the user.

(in my case I only know the time and date they paid and no other information)

Thanks again!!!!!
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.