random number generator

[scottdg]

I am trying to fix an existing RNG that selects the generates 10 random numbers between 1 and the number of records in the table. The problem is the numbers within those 10 can be duplicated and often are with smaller data sets. Currently it is looping through ten times and choosing a random number and each time writing the number to the table. I am wondering how I can check the table to see if the number has been written and if it has choose again until all ten numbers have been chosen.

I also saw somewhere that this can be done with an array and then the number can be removed from the array but I am not sure how to accomplish that either.

Thanks,


Scott

[Perceptus]

You could use a Dlookup call against the table to check for the number.

[scottdg]

Thanks,

Any suggestions on how to implement that given the current loop?

Do
  Do While K < 11
    'K = K + 1
        Randomize
          If K = 0 Then
            TxtOutput = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput
            rs.Update
            K = K + 1
          ElseIf K = 1 Then
            TxtOutput2 = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput2
            rs.Update
            K = K + 1
          ElseIf K = 2 Then
             TxtOutput3 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput3
             rs.Update
             K = K + 1

also does dlookup return a value? I just want to check see if the number exists in the table, if not display it and write it to the table. If it does generate a new number.

[Perceptus]

This may work for you, mind that I didn't know the name of yourt table to reference, you would need to update that to match your table.

Dim dict As Dictionary ' needs microsoft scripting runtime reference in vb
Dim lngI As Long
Dim lngRandom As Long
Dim rs As Recordset
For lngI = 1 To DCount("*", "tblYourtable")
1:
    lngRandom = Fix(i# * Rnd) + 1
    If dict.Exists(lngRandom) Then
        GoTo 1
    Else
        dict.Add lngRandom, lngRandom
        rs(lngI).FieldSize(0).Value = lngRandom
    End If
Next

[Perceptus]

There may be a better way to do this with arrays and such. seeding the contents of the array with numbers and then removing those portions of the array as you cycle down through. Im concerned my previous post might run a bit long when trying to resolve the last few records.

[scottdg]

There may be a better way to do this with arrays and such. seeding the contents of the array with numbers and then removing those portions of the array as you cycle down through. Im concerned my previous post might run a bit long when trying to resolve the last few records.

Thanks - I have to admit I am pretty new to VBA and have not done much OOP in general so I am not sure how to accomplish what you are suggesting.
Here is how the button is currently coded on click. Any other help or ideas is greatly appreciated.

Private Sub cmdGo_Click()
Dim db As DAO.Database
Dim rstRecords As DAO.Recordset
Dim rs As DAO.Recordset
Dim tdfNew As TableDef
Dim fldNew As Field
Dim i As Integer
Dim K As Integer
Dim Check As String
Set db = CurrentDb
Set rstRecords = db.OpenRecordset("t_County10")
     rstRecords.MoveLast
     FindRecordCount = rstRecords.RecordCount
     i = rstRecords.RecordCount
DoCmd.DeleteObject acTable, "C10_RNG"
     
'--- create the table
Set tdfNew = db.CreateTableDef("C10_RNG")
'--- add text field (length 20)
Set fldNew = tdfNew.CreateField("RNG_NO", dbLong)
'--- save the new field
tdfNew.Fields.Append fldNew
'--- save the new table design
db.TableDefs.Append tdfNew
'---Initialize your recordset
Set rs = CurrentDb.OpenRecordset("C10_RNG", dbOpenDynaset)
     
On Error GoTo errhandler
     If TxtInput > 32767 Then
        MsgBox "Enter a positive, whole number between 1 and 32,767", vbOKOnly, "Input Error"
     ElseIf TxtInput < 1 Then
        MsgBox "Enter a positive, whole number between 1 and 32,767", vbOKOnly, "Input Error"
     End If
'Dim i As Integer
'Dim K As Integer
'Dim Check As String
'i = TxtInput
  TxtInput = i
  K = 0
  Check = T
Do
  Do While K < 11
    'K = K + 1
        Randomize
          If K = 0 Then
            TxtOutput = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput
            rs.Update
            K = K + 1
          ElseIf K = 1 Then
            TxtOutput2 = Fix(i * Rnd) + 1
            rs.AddNew
            rs.Fields(0).Value = TxtOutput2
            rs.Update
            K = K + 1
          ElseIf K = 2 Then
             TxtOutput3 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput3
             rs.Update
             K = K + 1
          ElseIf K = 3 Then
             TxtOutput4 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput4
             rs.Update
             K = K + 1
          ElseIf K = 4 Then
             TxtOutput5 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput5
             rs.Update
             K = K + 1
          ElseIf K = 5 Then
             TxtOutput6 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput6
             rs.Update
             K = K + 1
          ElseIf K = 6 Then
             TxtOutput7 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput7
             rs.Update
             K = K + 1
          ElseIf K = 7 Then
             TxtOutput8 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput8
             rs.Update
             K = K + 1
           ElseIf K = 8 Then
             TxtOutput9 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput9
             rs.Update
             K = K + 1
           ElseIf K = 9 Then
             TxtOutput10 = Fix(i * Rnd) + 1
             rs.AddNew
             rs.Fields(0).Value = TxtOutput10
             rs.Update
             K = K + 1
             Check = f
            Exit Do
          End If
    Loop
Loop Until Check = f
Exit Sub
errhandler:
If Err.Number = 11 Or Err.Number = 13 Then
MsgBox "Enter a positive, whole number between 1 and 32,767", vbOKOnly, "Input Error"
End If
End Sub

[Perceptus]

Do you need to randomize this field or do you need a unique randomized number? If you need the 2nd, you can tell the table designer to use an autonumber field and set the new values to be random, and the duplicates ok to be false.

[orange]

Scottdg,
I'm missing something with your intent to ensure all numbers get chosen.
If you are choosing random numbers, any number within the range should be available for random selection.

If you only want to select each of the records you have, why bother with Random number.

Can you please describe again what you are trying to accomplish?

[scottdg]

I need 10 unique random numbers. I tried setting the attributes you mentioned but it still does not work. First the table is deleted and then I rewrote the code so that when it is recreated it sets the attributes as you suggested.

Any other suggestions?

I appreciate the help so far.

'--- create the table
Set tdfNew = db.CreateTableDef("C10_RNG")
'--- add text field (length 20)
Set fldNew = tdfNew.CreateField("RNG_NO", dbLong)
'--- Set properties
fldNew.Attributes = dbAutoIncrField
'--- Append to table
tdfNew.Fields.Append fldNew
'--- Append table to db
db.TableDefs.Append tdfNew
db.Execute "CREATE UNIQUE INDEX RNG_NO ON C10_RNG (RNG_NO)"

'--- Set value for number to random num function
tdfNew.Fields("RNG_NO").DefaultValue = "GenUniqueID()"

[scottdg]

Orange,
I sure can and thanks for your response. This is being used to generate reports for inspections. So we are taking the record count in the table and using that as our pool to take customers from that are due for inspection for that county. So if I have a county with 71 stores I need to be able to produce 10 different numbers. Those numbers are written to a table and that data is used to pull the customer information to create an inspection report that is brought by the inspector to the site. It is okay if from one button click to the next some numbers are generated more than once. That should be expected the fewer the records there are for a given county. But we cannot have the same numbers appear twice in a single click.

[orange]

I have a small routine to pick random numbers from a defined range.

'---------------------------------------------------------------------------------------
' Procedure : randomNumber
' Author    : Jack
' Created   : 11/18/2010
' Purpose   : To Generate Random numbers between and including a range of numbers.
'Lo and Hi are the lowest and highest random numbers you wish to generate.
'The Randomize keyword is critical to getting different results for each Access session.
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'------------------------------------------------------------------------------
'
Function randomNumber(Lo As Long, Hi As Long) As Long
10       On Error GoTo random_Error
20    Randomize
30    randomNumber = Int(((Hi - Lo + 1) * Rnd) + Lo)

40       On Error GoTo 0
50       Exit Function

random_Error:

60        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure random of Module AccessMonster"
End Function

I have written a small test program (below) to see how many iterations it takes to find 10 unique random numbers (no repetitions/duplicates) from a range of 1 to 10.

Here is the code

Sub mytestOfRandomNumber()
    Dim a As Long
    Dim z As Long
    Dim i As Integer
    Dim idx As Integer
    Dim RndNo As Integer
    Dim tNum As Integer    'test number
    Dim results(10) As Integer    ' 11 elements in this array ; each is initialized to 0
                                  'must ignore element 0
   On Error GoTo mytestOfRandomNumber_Error

10  tNum = 0
20  a = 1                         'low   end of range
30  z = 10                        'high end of range
   
GetARandomNumber:
40  tNum = tNum + 1
50  RndNo = randomNumber(a, z)  'this could be changed depending on the range you need
60  results(RndNo) = RndNo

    'Debug.Print results(RndNo) 'uncomment to see individual numbers
70  For idx = LBound(results) + 1 To UBound(results)    ' must ignore  element 0
80      If results(idx) = 0 Then GoTo GetARandomNumber
90  Next idx
Summary:
100 Debug.Print "It took " & tNum & " tests to get 10 unique random numbers from " & a & "  thru  " & z

   On Error GoTo 0
   Exit Sub

mytestOfRandomNumber_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mytestOfRandomNumber of Module AccessMonster"
End Sub

and here are the results of a number of tests.

It took 36 tests to get 10 unique random numbers from 1  thru  10
It took 86 tests to get 10 unique random numbers from 1  thru  10
It took 17 tests to get 10 unique random numbers from 1  thru  10
It took 20 tests to get 10 unique random numbers from 1  thru  10
It took 36 tests to get 10 unique random numbers from 1  thru  10
It took 28 tests to get 10 unique random numbers from 1  thru  10
It took 30 tests to get 10 unique random numbers from 1  thru  10
It took 21 tests to get 10 unique random numbers from 1  thru  10
It took 34 tests to get 10 unique random numbers from 1  thru  10
It took 48 tests to get 10 unique random numbers from 1  thru  10
It took 24 tests to get 10 unique random numbers from 1  thru  10
It took 26 tests to get 10 unique random numbers from 1  thru  10
It took 25 tests to get 10 unique random numbers from 1  thru  10
It took 15 tests to get 10 unique random numbers from 1  thru  10

You may find part of this useful to you. I realize you want unique random numbers, and that's fine for your purpose, but in true randomness I think duplicates/replicates are possible.

Good luck.

[scottdg]

Thanks for the attempt. The numbers definitely need to be unique. Using randomize I am able to get "relatively random" numbers (if that makes sense). This is run once per month I believe so if they are repeated occasionally for a smaller set that is to be expected but they must be unique each time it is run. It doesn't appear as if this will do that any better than what I currently have based on your results at the bottom.

Any other suggestions are appreciated.

I have a small routine to pick random numbers from a defined range.

'---------------------------------------------------------------------------------------
' Procedure : randomNumber
' Author    : Jack
' Created   : 11/18/2010
' Purpose   : To Generate Random numbers between and including a range of numbers.
'Lo and Hi are the lowest and highest random numbers you wish to generate.
'The Randomize keyword is critical to getting different results for each Access session.
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'------------------------------------------------------------------------------
'
Function randomNumber(Lo As Long, Hi As Long) As Long
10       On Error GoTo random_Error
20    Randomize
30    randomNumber = Int(((Hi - Lo + 1) * Rnd) + Lo)

40       On Error GoTo 0
50       Exit Function

random_Error:

60        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure random of Module AccessMonster"
End Function

I have written a small test program (below) to see how many iterations it takes to find 10 unique random numbers (no repetitions/duplicates) from a range of 1 to 10.

Here is the code

Sub mytestOfRandomNumber()
    Dim a As Long
    Dim z As Long
    Dim i As Integer
    Dim idx As Integer
    Dim RndNo As Integer
    Dim tNum As Integer    'test number
    Dim results(10) As Integer    ' 11 elements in this array ; each is initialized to 0
                                  'must ignore element 0
   On Error GoTo mytestOfRandomNumber_Error

10  tNum = 0
20  a = 1                         'low   end of range
30  z = 10                        'high end of range
   
GetARandomNumber:
40  tNum = tNum + 1
50  RndNo = randomNumber(a, z)  'this could be changed depending on the range you need
60  results(RndNo) = RndNo

    'Debug.Print results(RndNo) 'uncomment to see individual numbers
70  For idx = LBound(results) + 1 To UBound(results)    ' must ignore  element 0
80      If results(idx) = 0 Then GoTo GetARandomNumber
90  Next idx
Summary:
100 Debug.Print "It took " & tNum & " tests to get 10 unique random numbers from " & a & "  thru  " & z

   On Error GoTo 0
   Exit Sub

mytestOfRandomNumber_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure mytestOfRandomNumber of Module AccessMonster"
End Sub

and here are the results of a number of tests.

It took 36 tests to get 10 unique random numbers from 1  thru  10
It took 86 tests to get 10 unique random numbers from 1  thru  10
It took 17 tests to get 10 unique random numbers from 1  thru  10
It took 20 tests to get 10 unique random numbers from 1  thru  10
It took 36 tests to get 10 unique random numbers from 1  thru  10
It took 28 tests to get 10 unique random numbers from 1  thru  10
It took 30 tests to get 10 unique random numbers from 1  thru  10
It took 21 tests to get 10 unique random numbers from 1  thru  10
It took 34 tests to get 10 unique random numbers from 1  thru  10
It took 48 tests to get 10 unique random numbers from 1  thru  10
It took 24 tests to get 10 unique random numbers from 1  thru  10
It took 26 tests to get 10 unique random numbers from 1  thru  10
It took 25 tests to get 10 unique random numbers from 1  thru  10
It took 15 tests to get 10 unique random numbers from 1  thru  10

You may find part of this useful to you. I realize you want unique random numbers, and that's fine for your purpose, but in true randomness I think duplicates/replicates are possible.

Good luck.

[orange]

scottdg,

The use of Randomize is to get a different "seed" each time you invoke the routine. Without it, you could get the same number repeatedly.

If you want 5 random numbers from a set 1 through 10, you could get 1,6,3,6,9 or 3,3,3,4,3. It is random, so you could get repeats. My test set up was to see how many tests I would have to do to ensure each of the numbers was selected. So in the test, using Randomize, it took between 15 and 86 tests to ensure each number ( 1- 10) was selected at least once.

An analogous situation is to have 10 balls numbered 1 through 10. You put the balls into a bag and draw out 1 ball, and record its number, then replace the ball. How many draws do you have to make to get/draw each of the 10 numbers at least once?

Good luck.

[scottdg]

Thanks Orange. I understand what it is doing. Unfortunately the user would not really understand. All they know is they want to press a button and get 10 different numbers. The smallest set I have to deal with I believe is about 70 records. I get duplicates at least half the time I run it.

I think the only way to do it is to check the table each time through the loop to make sure the number has not been written any of the previous times through. I am just not sure how to accomplish that.

[orange]

You may get some ideas from this material
https://www.accessforums.net/tutoria...oup-41737.html

If you need 10 unique numbers from a set (1-70) and you don't want repeats until all 70 have been chosen, then
I would record the "chosen" numbers selected in a table. Then I would exclude those numbers in subsequent runs.

...where Numbers NOT IN (Select ChosenNumbers from MyTable)

Good luck.