VBA Access Random String Generator Search Through List Before Giving Results

Side note:  It would be prudent to limit the number of times the algorithm tries to generate a string.  This defends against several issues, among which are:

• It might sit for hours running over and over again as it repeatedly linearly searches and compares every previous entry in a very large table.
• The "random" number generator is not random, and does have patterns.

Mid(StrRnd, lngN + 1) = strChar

This statement evaluates to True or False, without making use of it.

Since you use random numbers, why are you not using autonumber?

Klahn

It might sit for hours running over and over again as it repeatedly linearly searches and compares every previous entry in a very large table.

I dont agree this!
to get the same number with this algorithm for 6 digit is

1 in 42^6 = 5,489,031,744!!!

with 11 char (op uses 11 in the code)

1 in 42^11 = 717,368,321,110,468,608!!!
I dont think we have so many invoices... if it is, op would be the richest guy in the world and would not ask such questions here :)

Thank you all for the help. I will try tomorrow when I am back at work these ideas and see what I come up with.  

I do use auto number for my table IDs. But the SKUs I use is a 11 character alphanumeric string. This is just what we use in the business for a Identifier for people to ID a product.

Currently there are around 10,000 SKUs and growing. I used to use a different more random string generator that seems to work good for what I needed but it had a few kinks in it and the some of the code Microsoft stopped servicing in the last few months in an update.

Thanks for all the help.

Hainkurt that was a good laugh. Amen to that!

Is this simple example represents the issue?
product x with some description: ABC101
Product x with other description: ABC102

product x with some description: AAB101
Product x with other description: AAB102
product x with some description: AAB103
Product x with other description: AAB104

If so, then have 3 fields,
fld1(3 characters) for first part of SKU, use an existing value or create it if not existent.
fld2(3 digits) for second part of SKU, create it from the maximum value of fld2 + 1 where fld1=the current value of fld1
fld3(3 characters + 3 digits), a concatenation from fld1 and fld2.

I expect collisions.  I've detailed the reasons in this article:
https://www.experts-exchange.com/articles/11114/An-Examination-of-Visual-Basic's-Random-Number-Generation.html

Thank you all for the help. I finally have some time to try these solutions.

aikimark

Thank you. About a year ago you helped me with a similar situation and it worked great until a few months ago after I updated my PC and I guess after some research Microsoft stopped servicing some parts of it.

Here is what you provided me with at the time:

Function UniqueString(ByVal parmLen) As String
    Const cAlphabet = "ABCDEFGHJKMNPQRSTUVWXYZ0123456789"
    Const AlphabetLen = 33
    Dim lngLoop As Long
    Dim lngOffset As Long
    Dim lngPosn As Long
    Dim GUID As String
    Dim GUID_Trailer As String
    
    Do
        GUID = GUID & Replace(Mid(CreateObject("scriptlet.typelib").GUID, 2, 36), "-", vbNullString)
    Loop Until Len(GUID) >= parmLen
    
    UniqueString = String(parmLen, "*")     'initialize output string
    Select Case Len(GUID)
        Case parmLen
            'convert entire GUID to string
            lngPosn = 1
            For lngLoop = 1 To Len(GUID) Step 2
                lngOffset = "&h" & Mid(GUID, lngLoop, 2)
                Mid(UniqueString, lngPosn, 1) = Mid(cAlphabet, (lngOffset Mod AlphabetLen) + 1, 1)
                lngPosn = lngPosn + 1
            Next
            
        Case Is > parmLen
            'use remaining byte values as increment, mod 256
            GUID_Trailer = Mid(GUID, (parmLen * 2) + 1)
            Do
                GUID_Trailer = GUID_Trailer & GUID_Trailer
            Loop Until Len(GUID_Trailer) >= ((parmLen * 2) + 6)
            
            GUID = Left(GUID, (parmLen * 2))
            
            lngPosn = 1
            For lngLoop = 1 To Len(GUID) Step 2
                lngOffset = CLng("&h" & Mid(GUID, lngLoop, 2)) + CLng("&h" & Mid(GUID_Trailer, lngPosn, 6))
                Mid(UniqueString, lngPosn, 1) = Mid(cAlphabet, (lngOffset Mod AlphabetLen) + 1, 1)
                lngPosn = lngPosn + 1
            Next
        
    End Select
End Function

Select allOpen in new window

If I recall it was the "scriptlet.typelib" microsoft stopped servicing. Also I had a similar question back in June and Gustav Brock here as an expert found a glitch in it that I never knew about because I never ran it over 11 Characters longs.

Gustav Brock Quoted:

That said, your function fails for me; the last half of the requested string is stars only:

? UniqueString(32)
80Z2X38JBHHBWUCQ****************

and for some length, for example 16 and 48, it goes into an endless loop, so you will have to kill Access.

Anyways that one worked perfect for me until a few months ago as it seemed to be really random.




HainKurt I have tried your method but I can't seem to get it correct. I keep getting a type mismatch error:

Option Compare Database
'Option Explicit


Public Function StrRandomWithDummy3(ByVal Dummy As Variant, ByVal lngLen As Long) As String

'On Error GoTo ErrorHandler

'**TO USE IN A QUERY EXAMPLE: "SKU: StrRandomWithDummy3([Replace this with any other Field Name used in the Query],11)"
' Create fixed length string of random characters.
' Will generate about 512K per second.
'
' 2002-02-02. Cactus Data ApS, CPH

    Dim StrRnd        As String
    Dim lngN          As Long
    Dim strChar       As String
    
    Randomize
    lngLen = Abs(lngLen)
    ' Create string of zeroes, lngLen long.
    StrRnd = String(lngLen, "0")
    ' Perform hi-speed filling of string with random character string.
     
   Dim skuOK As Boolean
   
     skuOK = False
While Not skuOK
 While lngN < lngLen
        strChar = Chr(48 + Rnd * (90 - 48)) '48-57 is the ASCII for 0 through 9 and 90 - 65 is the ASCII for Capital A through Z.
        Select Case strChar
            Case "I", "L", "O", ":", ";", "<", "=", ">", "?", "@" ' Ignore these characters
             Case Else
                Mid(StrRnd, lngN + 1) = strChar
                ' Calculate entry position for next substring.
                lngN = lngN + 1
        End Select
    Wend
  
skuOK = ("SELECT sku FROM Skus WHERE sku=strRnd;") = (0)
  
  
Wend

    StrRandomWithDummy3 = StrRnd
  
Exit Function

ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " in " & _
   VBE.ActiveCodePane.CodeModule, vbCritical, "Error"
End Function

Select allOpen in new window

Thanks for the help. That last part really helped. I understand you showed me just the logic and I tried to give it a good shot. Thanks again!

I modified your code and made it better :)

Public Function ExecScalar(ByVal sql As String)
    With CurrentDb.OpenRecordset(sql)
        If .EOF Then
            ExecScalar = Null
        Else
            ExecScalar = .Fields(0).Value
        End If
        .Close
    End With
End Function

Public Function StrRandomWithDummy(ByVal Dummy As Variant, ByVal lngLen As Long) As String

'On Error GoTo ErrorHandler

    Dim StrRnd        As String
    Dim strChar       As String
    Dim LegalChars    As String
    Dim LegalCharsLen As Long
    LegalChars = "0123456789ABCDEFGHJKMNPQRSTUVWZ"
    LegalCharsLen = Len(LegalChars)
    Dim skuOK As Boolean
    
    Randomize

    skuOK = False
    While Not skuOK
     For i = 1 To lngLen
        Dim r As Integer
        r = CInt(Rnd * (LegalCharsLen - 1)) + 1
        StrRnd = StrRnd & Mid(LegalChars, r, 1)
     Next
     skuOK = ExecScalar("SELECT count(1) FROM Skus WHERE " & Dummy & "='" & StrRnd & "'") = 0
    Wend

    StrRandomWithDummy = StrRnd
  
Exit Function

ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " in " & _
   VBE.ActiveCodePane.CodeModule, vbCritical, "Error"
End Function

Select allOpen in new window

not sure what dummy is used here though... not used anywhere...
tested with immediate window as

?StrRandomWithDummy("SKU", 11)
AZW0WWM7JGZ
ETHWCK24QSF
4SW1S386F4D
D914EKZM1NS
14824QRBQM0
8VCD6MN9H5P
N5488S8NQ3F
TA3QEBRKBBV
CE1TNES9444
RPSTWGUFMNP
4QV7HGEG7Z9

Select allOpen in new window

this is much better than your code and takes cares of duplicate issue forever :)
to get duplicate if you have 10K records is

10K/(31^11), 10K in 25408476896404831, or 1 in 2,540,847,689,640!!!

Thanks for the updated version. I will try it.

I mixed together Original, Yours, and aikimark's version I hope this is right. I want it to be more random.

Option Compare Database
Option Explicit

Public Function StrRandomWithDummy2(ByVal Dummy As Variant, ByVal lngLen As Long, Optional parmResetRand As Boolean = False) As String

    '**TO USE IN A QUERY EXAMPLE: "SKU: StrRandomWithDummy([Replace this with any other Field Name used in the Query],11)"
    ' Create fixed length string of random characters.
    ' Will generate about 512K per second.
    '
    ' 2002-02-02. Cactus Data ApS, CPH
    ' 2017-09-16  aikimark - tweaked original code to increase uniqueness
    '           Note: actual performance may be closer to 100K/second
    
    Dim StrRnd        As String
    Dim lngN          As Long
    Dim strChar       As String
    
    Static colThing As Collection
    Dim sngRand As Single
    Const cValidChars As String = "0123456789ABCDEFGHJKMNPQRSTUVWXYZ"
    
    If (colThing Is Nothing) Or (parmResetRand = True) Then
        Set colThing = New Collection
        Randomize CLng(Date)
        For lngN = 1 To CLng(Date)  'offset Rnd sequence by date
            Rnd
        Next
    End If
    
    
    Dim skuOK As Boolean
   
     skuOK = False
While Not skuOK

    lngLen = Abs(lngLen)
    ' Create string of zeroes, lngLen long.
    StrRnd = String(lngLen, "0")
    ' Perform hi-speed filling of string with random character string.
    For lngN = 1 To lngLen
        sngRand = (((Rnd * Len(cValidChars)) + 1) * (Timer * 100)) Mod Len(cValidChars)
        strChar = Mid(cValidChars, sngRand + 1, 1)
        Mid(StrRnd, lngN, 1) = strChar
    Next
    
skuOK = ExecScalar("SELECT count(1) as cnt FROM Skus WHERE sku='" & StrRnd & "'") = 0

Wend

    StrRandomWithDummy2 = StrRnd
    
End Function


Private Function ExecScalar(ByVal sql As String)
    With CurrentDb.OpenRecordset(sql)
        If .EOF Then
            ExecScalar = Null
        Else
            ExecScalar = .Fields(0).Value
        End If
        .Close
    End With
End Function

Select allOpen in new window

I use the Dummy in queries.

not sure why you added so much code...
the one I posted should do the job...

@Dustin

scriptlet.typelib
Are you running in a 64-bit version of Windows/Office?

one correction to my solution above
we need to use int() not cint()

Public Function StrRandomWithDummy(ByVal Dummy As Variant, ByVal lngLen As Long) As String
    Dim StrRnd        As String
    Dim strChar       As String
    Dim LegalChars    As String
    Dim LegalCharsLen As Long
    LegalChars = "0123456789ABCDEFGHJKMNPQRSTUVWZ"
    LegalCharsLen = Len(LegalChars)
    Dim skuOK As Boolean
    Dim r As Integer
    
    Randomize

    skuOK = False
    While Not skuOK
     For i = 1 To lngLen
        r = Int(Rnd * LegalCharsLen) + 1
        StrRnd = StrRnd & Mid(LegalChars, r, 1)
     Next
     skuOK = ExecScalar("SELECT count(1) FROM Skus WHERE " & Dummy & "='" & StrRnd & "'") = 0
    Wend

    StrRandomWithDummy = StrRnd
End Function

Select allOpen in new window

Cint(2.99)=3
Int(2.99)=2

rnd * n : gives [0.000 - n)
cint(rnd * n) : gives [0 - n] (probability of 0 and n is half of other numbers)
int(rnd * n) : gives [0 - n-1]
int(rnd * n) + 1 : gives [1 - n] >>> which we need!!!

Select allOpen in new window

@ aikimark

No I am using 32 Bit.

@HainKurt

Thanks for the correction.