Random alphanumeric generator with unique validator returning extra digits when finding unique conflicts

Question

I am using this code to call a random alpha numeric string. I am doing so via textbox in an Access Form.

https://www.devhut.net/2010/06/22/ms-access-vba-generate-a-random-string/

I am trying to get it to also validate it's uniqueness in a column in Access. When it fails it should run again. It however fixes that problem by doubling the digits it generates. For example to test this I am running it on a field populated with entries from 01-98. It should generate only a two digit numeric string but it returns a 4 digit.

I'm no coder btw and very unfamiliar with VB. I just rip code off the internet, and pray it works. So I might not understand things when you reply back.

Function GenRandomStr(iNoChars As Integer, _
                  bNumeric As Boolean, _
                  bUpperAlpha As Boolean, _
                  bLowerAlpha As Boolean)
On Error GoTo Error_Handler
Dim AllowedChars()        As Variant
Dim iNoAllowedChars       As Long
Dim iEleCounter           As Long
Dim i                     As Integer
Dim iRndChar              As Integer

Dim varCountOfResults As Integer

varCountOfResults = 1

While varCountOfResults > 0

'Initialize our array, otherwise it throws an error
ReDim Preserve AllowedChars(0)
AllowedChars(0) = ""

'Build our list of acceptable characters to use to generate a string from
'Numeric -> 48-57
If bNumeric = True Then
    For i = 48 To 57
        iEleCounter = UBound(AllowedChars)
        ReDim Preserve AllowedChars(iEleCounter + 1)
        AllowedChars(iEleCounter + 1) = i
    Next i
End If
'Uppercase alphabet -> 65-90
If bUpperAlpha = True Then
    For i = 65 To 90
        ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
        iEleCounter = UBound(AllowedChars)
        AllowedChars(iEleCounter) = i
    Next i
End If
'Lowercase alphabet -> 97-122
If bLowerAlpha = True Then
    For i = 97 To 122
        ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
        iEleCounter = UBound(AllowedChars)
        AllowedChars(iEleCounter) = i
    Next i
End If

'Build the random string
iNoAllowedChars = UBound(AllowedChars)
For i = 1 To iNoChars
    Randomize
    iRndChar = Int((iNoAllowedChars * rnd) + 1)
    GenRandomStr = GenRandomStr & Chr(AllowedChars(iRndChar))
Next i

varCountOfResults = DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'")


Wend

Error_Handler_Exit:
On Error Resume Next
Exit Function

Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
       "Error Number: " & Err.Number & vbCrLf & _
       "Error Source: GenRandomStr" & vbCrLf & _
       "Error Description: " & Err.Description & _
       Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
       , vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

Answer 1

You need to add GenRandomStr = "" at the top of the loop, otherwise a second/third trip through will just add to the existing string.

Refactored a little and untested because I don't have Access:

Function GenRandomStr(iNoChars As Integer, _
                  bNumeric As Boolean, _
                  bUpperAlpha As Boolean, _
                  bLowerAlpha As Boolean)


    Dim AllowedChars As String, iEleCounter As Long
    Dim i As Long, iRndChar As Long, iNoAllowedChars As Long

    If bNumeric Then AllowedChars = "0123456789"
    If bUpperAlpha Then AllowedChars = AllowedChars & "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    If bLowerAlpha Then AllowedChars = AllowedChars & "abcdefghijklmnopqrstuvwxyz"

    iNoAllowedChars = Len(AllowedChars)
    Do
        GenRandomStr = ""
        For i = 1 To iNoChars
            Randomize
            iRndChar = Int((iNoAllowedChars * Rnd) + 1)
            GenRandomStr = GenRandomStr & Mid(AllowedChars, iRndChar, 1)
        Next i
        Exit Do
    Loop While DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'") > 0

End Function