Strategy for creating a random number generator

[EmmaOD91]

I know Excel has a built in Random function, but I wanted to try this with using that as a little challenge.

Basically I wanted to create something that would simulate the lottery, so that I could press a button and have it draw 6 random numbers from 1 to 49.

The code I used is as follows (it's not commented but I explain it below)

Private ballNumber As Integer

Private rowTracker As Integer
Private columnTracker As Integer

Private devTracker As Integer

Private moveOn As Boolean
---------------------------------
Sub playLotteryLots()

Application.ScreenUpdating = False

rowTracker = 2

For j = 1 To 300
Call playLottery
Next j

MsgBox ("Done")
Application.ScreenUpdating = True
End Sub
-----------------------------------
Sub playLottery()

columnTracker = 1

For columnTracker = 1 To 6

    moveOn = False
    
    While moveOn = False
        Call getRandomTwoDigits
        Call pullNumber
        moveOn = True
        If columnTracker <> 1 Then checkNumber
    Wend

    Call addNumber
    Call updateDoneList
Next columnTracker

rowTracker = rowTracker + 1

End Sub
----------------------------------
Private Sub getRandomTwoDigits()

Dim validNumber As Boolean

validNumber = False

While validNumber = False
    Range("A1").Formula = "=NOW()"
    ballNumber = Right(Range("A1").Value, 2)
    
    If ballNumber < 98 Then
        ballNumber = ballNumber + 1
        validNumber = True
    End If
Wend

End Sub
------------------------------------------------
Private Sub pullNumber()

If ballNumber > 49 Then
    ballNumber = ballNumber - 49
End If
    
End Sub
------------------------------------------------
Private Sub addNumber()

Cells(rowTracker, (columnTracker + 3)).Value = ballNumber
    
End Sub
------------------------------------------------
Private Sub checkNumber()

    For i = 2 To 6
        If ballNumber = Cells(rowTracker, i).Value Then
            moveOn = False
        End If
    Next i

End Sub

So a prerequisite for this to work, is that cell A1 on whichever sheet needs to be formatted to display the time including milliseconds. All this does really is take the milliseconds from the time of iteration and then convert them into a number between 1 and 49.

This is repeated for each ball with a check to ensure that number hasn't been drawn already. If the number has been drawn already, the ball is redrawn.

This version of the code will loop 300 times to get a wide spread of results though you may want to turn that number up or down depending on how long you want to wait.


So:

getRandomTwoDigits: This pulls the milliseconds from the current time. 1 is added to the number drawn (so that we don't draw the number 0) If the starting number is 98 or 99 the number is redrawn. (inefficient but the easiest way to do it)

pullNumber: This just checks to see if the number pulled from the ms is above 49, if it is then we minus 49 to ensure there's an even chance of any number being drawn.

addNumber: This adds the number drawn to a results table

checkNumber: Checks the current row of the results table to see if the number has been drawn during this game. If it has, the ball is redrawn

Problems

One big problem is that the code takes about the same amount of time to run. Which means every time a 3 is drawn as the first number, the second number will always be an 11 and the third an 18. (At least on my machine)

The other big problem is that some numbers are just never drawn. This one puzzles me as I can't work out why. But the number 1 is never drawn, nor the number 2 and a few others somewhere in the middle never show up either.

Any idea of where I'm going wrong?

 

[RickXL]

Hi.

When I tried your code I discovered that you have not posted UpdateDoneList - so I commented that out.

Also, when I tried

    Range("A1").Formula = "=NOW()"
    ballNumber = Right(Range("A1").Value, 2)

it always returned the seconds from the time value. So the number never exceeds 59 and when I inserted a debug.print statement it reported the same time being found many times. You will need a more precise timer, I suspect, to make it work.

I can give you one that does work if that is of any interest:

Sub RandNo()
    Dim slRnd As Object
    Set slRnd = CreateObject("System.Collections.SortedList")
    For i = 1 To 49
        slRnd.Item(Rnd) = i
    Next
    For i = 1 To 6
        Worksheets("Sheet1").Cells(2, i + 3) = slRnd.GetByIndex(i - 1)
    Next
End Sub

 

[EmmaOD91]

Hi Rick, thanks for the response

Sorry, "updateDoneList" was there when I first started typing that post. I realised partway through that I could adjust one line of code and remove updateDoneList completely so I did. Then forgot to take out the reference to it I guess

And I mentioned that cell A1 has to be formatted to display the time in milliseconds for it to work (otherwise you get the problem with seconds).

Try formatting A1 and give it another bash, it's still not completely random (see above problems) but it kinda works a bit.



Would you mind explaining the code you posted to me? I'm not familiar with the type of variable you used nor the commands associated with it.

 

[EmmaOD91]

Also, the numbers that never come up are

1
2
22
31

It's so weird, I don't get it at all.

 

[gaz_chops]

Wow! Thats mine and my OH birthdates!! And the lottery numbers are?

 

[Trebor76]

Hi EmmaOD91,

have a look at this thread for some random number generator examples, especially mirabeau's suggested solution on thread # 8.

Regards,

Robert

 

[RickXL]

Hi.

OK, I missed the part about formatting the time in milliseconds but that was probably partly due to the fact that the NOW() function does not have a resolution of milliseconds. You can format it that way but you are fooling yourself. Dates are represented in Excel as a 10-digit number with a decimal point in the middle. The integer part is a day number and the fractional part is a fraction of a day. So the maximum resolution can't be more than about 0.0001 of a day.

The smallest step I could manage in a test was 0.157 seconds. You need a better timer and better resolution than the NOW() function can give you.

This is one from here: https://msdn.microsoft.com/en-us/li...e2007excelPerf_MakingWorkbooksCalculateFaster

Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
'
Function MicroTimer() As Long

    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0

' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
    getTickCount cyTicks1

' MilliSeconds
    If cyFrequency Then MicroTimer = 1000 * cyTicks1 / cyFrequency
End Function

Sub test()
    Range("A1")= MicroTimer
End Sub

The last three digits of that will be milliseconds.


Going back to my previous post ...

Sub RandNo()
    Dim slRnd As Object
    Set slRnd = CreateObject("System.Collections.SortedList")
    For i = 1 To 49
        slRnd.Item(Rnd) = i
    Next
    For i = 1 To 6
        Worksheets("Sheet1").Cells(2, i + 3) = slRnd.GetByIndex(i - 1)
    Next
End Sub

Basically, what it does is create an array with two columns. One column has the numbers from 1 to 49 in it and the second has a random number in it. The ordinary VBA Rnd function is used.
The two column array is then sorted by the random number column and the top 6 numbers are written to the worksheet.

Unfortunately, ordinary VBA arrays cannot easily be sorted so I used a special type of array called a SortedList. A SortedList sorts into the right order every time a new pair or numbers is added so no special sorting operation is required. It is built in to the SortedList functionality.

slRnd.Item(Rnd) = i

The line above adds a new item to the SortedList. Its key=Rnd and its value=i. The values are sorted by Rnd as soon as it is added.
The loop it is in fills up the array with all 49 numbers.
The next loop reads out the first 6 numbers which are in order of Rnd.