Trying to generate random numbers in VBA, code returning only values that already exist in the table

Question

I cannot get what this is doing.

For a data entry work, I need to generate a transaction number for each entry.

I have a simple function that returns a string created from a random number:

Public Function GetNewTnum() As String

    Randomize 10
    GetNewTnum = "SL-" & Int(Rnd * 1000000)

End Function

When I call the function in the sub, not only is it generating the same number everytime it runs, the number can already be found in the data set, which only has 577 entries at the moment!

In the sub, after generating the string, it checks to see if has already been used and another function returns true/false. A loop keeps testing until the generated string has not been found and uses this in the entry:

Public Function finddupTnum(ByRef num As String) As Boolean
    
    Dim f As Range
    Set f = inputws.Range("tblDataMaster[Tnum]").Find(num, , xlValues, xlWhole)
    If f Is Nothing Then
        finddupTnum = False
    ElseIf Not f Is Nothing Then
        finddupTnum = True
    End If

End Function

Loop structure works fine. And even before the code reaches the loop, the first random number that gets generated is as described above:

Dim i As Integer
    For i = 1 To 7
        If Not Me.Controls("Product" & i) = "" Then
            With newrow
                newtnum = GetNewTnum()
                MsgBox "First tnum: " & newtnum
                valb = finddupTnum(newtnum)
                MsgBox "Found? " & valb
                Do While valb = True
                    newtnum = GetNewTnum()
                    valb = finddupTnum(newtnum)
                    MsgBox "New tnum: " & newtnum
                    MsgBox "New tnum dound? " & valb
                Loop

The loop can't end because all the values generated already exist.

Thank you for your help!

The way to do this in a random manner is to generate an array of 1 to 1,000,000 populated as 1 to 1,000,000. Then generate 1,,000,000 pairs of random numbers in the range 1 to 1,000,000. Use these random numbers as indeces and swap the two numbers at these indeces. Once this is completed the array will have been randomised and all values in the 1 to 1,000,000 array will be guaranteed to be unique. You could then generate a further random number in the range 1 to 1,000,000 to be the starting index for reading however many numbers you need (wrapping around if you get to 1,000,000). — freeflow, Jul 27 '21 at 21:26
Yikes... might be out of my league with that.. Thank you! I'll give it a shot — Carlos Andres, Jul 27 '21 at 21:32
I think you could use the RANDBETWEEN and COUNTIF worksheet functions to insert random numbers and check for duplicates — dbmitch, Jul 27 '21 at 22:01
@freeflow - The algorithm you're suggesting is biased. It will not produce truly randomised data. You only need to do a `for` loop from `1` to `1,000,000` and select a random number between the current value in the loop and `1,000,000` and swap those to get randomised data. It's a Fisher-Yates sort. — Enigmativity, Jul 27 '21 at 22:11
@freeflow - Check this question for a detailed explanation: https://stackoverflow.com/questions/67888049/bug-in-nets-random-class — Enigmativity, Jul 27 '21 at 22:13
@Enigmativity Thanks for the heads up. Makes interesting Reading. With respect to the OP, I think my suggestion provides a relatively easy way forward. The OP doesn't need true randomness, just a unique set of ID. — freeflow, Jul 28 '21 at 05:36
@freeflow - Yes, but the OP is way over thinking this. They just need to test a handful of random numbers at best. — Enigmativity, Jul 28 '21 at 05:45
True. Its a wonder why int( Now() *1,000,000) wasn't used as the Id. — freeflow, Jul 28 '21 at 06:07

score 4 · Answer 1 · answered Jul 27 '21 at 21:37

4

In VBA there is the need to use Randomize without a fixed number (the seed). Otherwise it will always generate the same numbers starting from that seed.

https://learn.microsoft.com/de-de/office/vba/language/reference/user-interface-help/randomize-statement

answered Jul 27 '21 at 21:37

Samuel

2,923
1
4
19

1

Thank you! I removed the randomize and now it works – Carlos Andres Jul 27 '21 at 22:11

Carlos Andres · Answer 2 · 2021-07-27T22:24:25.920

-1

I removed the Randomize statement and now its generating random numbers.

Also, I changed the loop struture. Now instead of finding generating a new random number, it simply adds 1 the first one created, searches and iterates.

I think at least this way, it will never find a duplicate:

newtnum = GetNewTnum()
                valb = finddupTnum(newtnum)
                Do While valb = True
                    newtnum = newtnum + 1
                    valb = finddupTnum(newtnum)
                Loop

And changed the function to make it the right data type ;)

edited Jul 27 '21 at 22:24

answered Jul 27 '21 at 22:14

Carlos Andres

69
1
8

Put back `Randomize` but don't give it a parameter. Also, this is a terrible way to find a new value. Your app has to keep going to back to the table to find a value. That's a `O(n^2)` complexity algorithm. – Enigmativity Jul 27 '21 at 22:18
What would be wrong with doing `WorksheetFunction.Max(range) + 1` instead? – Enigmativity Jul 27 '21 at 22:19
"I think at least this way, it will never find a duplicate" - No, this way is guaranteed to find every duplicate every single time. – Enigmativity Jul 27 '21 at 22:25
@Enigmativity I see. Thank you. I guess I could simply do that. No real reason other than I figured random numbers was the way to go – Carlos Andres Jul 27 '21 at 22:27
Random numbers are fine. Just use `WorksheetFunction.Match` to rule out if the number is already used. As long as your range of random numbers exceeds the number of records by a factor of 10 it should be super quick. – Enigmativity Jul 27 '21 at 22:31
@Enigmativity I changed it to the worksheet function. Much easier and less code! – Carlos Andres Jul 27 '21 at 22:33

dbmitch · Answer 3 · 2021-07-28T17:00:32.910

-2

This should work replacing your two functions - first to get random number, then check the current column for duplicates

Option Explicit

Const START_NUM     As Long = 1
Const END_NUM       As Long = 1000000
Const RANGE_COL     As String = "A"
Const RANGE_NUMS    As String = RANGE_COL & START_NUM & ":" & RANGE_COL & END_NUM


Public Function GetRandomNumber()
    Dim NewNum          As Double
    Dim NumEntries      As Long
    Dim NumTries        As Long
    
    NewNum = Application.WorksheetFunction.RandBetween(START_NUM, END_NUM)
    NumEntries = Application.WorksheetFunction.CountA(Range(RANGE_NUMS))
    NumTries = 1
    While (Application.WorksheetFunction.CountIf(Range(RANGE_NUMS), NewNum) > 1) And (NumTries <= NumEntries)
        NewNum = Application.WorksheetFunction.RandBetween(START_NUM, END_NUM)
        DoEvents
        NumTries = NumTries + 1
    Wend
    
    Debug.Print NewNum
End Function

edited Jul 28 '21 at 17:00

answered Jul 27 '21 at 22:22

dbmitch

5,361
4
24
38

1

If `CountA` returns a non-negative number, and `NumTries` starts at `1` and then only increments, then `NumTries < -NumEntries` will always be false. – Enigmativity Jul 27 '21 at 22:28
Wouldn't a simple loop with `WorksheetFunction.Match` be a better approach? – Enigmativity Jul 27 '21 at 22:29
Fixed the syntax error in comparison - should have been "<=" not "< -". Thanks for pointing that out @Enigmativity. Yes - I'm sure there are better approaches. – dbmitch Jul 28 '21 at 17:02

Trying to generate random numbers in VBA, code returning only values that already exist in the table

3 Answers3