- Home
- Premium Memberships
- Lottery Results
- Forums
- Predictions
- Lottery Post Videos
- News
- Search Drawings
- Search Lottery Post
- Lottery Systems
- Lottery Charts
- Lottery Wheels
- Worldwide Jackpots
- Quick Picks
- On This Day in History
- Blogs
- Online Games
- Premium Features
- Contact Us
- Whitelist Lottery Post
- Rules
- Lottery Book Store
- Lottery Post Gift Shop
The time is now 4:27 pm
You last visited
April 23, 2024, 8:32 pm
All times shown are
Eastern Time (GMT-5:00)
Excel VBA script to generate a list of 5 randomized draws (forum requested)
Published:
Updated:
A recent LP forum topic requested a script of some kind to generate randomized picks from the user's defined list of numbers. I wrote (a number of years prior) an Excel VBA script that does this. The script needs a tab labeled "Last" and then you put your list in the K column. One interesting aspect to the macro is that let's say you think digit 39 is very likely to come up so you list it two, three times or more in the list and you'll see it show up more often in the outputted list of 5 randomized draws at range M1:Q5. The script can be modified to output to generate more randomized draws and the intUniq variable can be changed to allow more or less numbers in your pool to randomize have the draws all be lower than a specified number, etc. Once again, I used/borrowed the BubbleSort sub from John Walkenbach, who has written several great books on Excel and VBA for Excel; this sub sorts arrays, a handy function indeed. I forget the reasons why goto statements are frowned upon, though I've stopped using them myself; forgive me if they offend your programming sensibilities.
Sub GenerateFiveRandDraws()
Dim x As Single, intDrw As Integer, ColRef As String, NumDy As Integer, sCol As String
Dim LastC5ol As String, intUniq As Integer, strDblChk As String, ChkRef As String, ArNums(1 To 5) As Integer
Dim Val1 As Integer, Val2 As Integer, Val3 As Integer, Val4 As Integer, Val5 As Integer, a As Integer, ValX As Integer
Dim rndstart As Single, intrndstart As Integer
Sheets("Last").Select
NumDy = 1
Do
intDrw = 1
Do
ColRef = Switch(intDrw = 1, "M", intDrw = 2, "N", intDrw = 3, "O", intDrw = 4, "P", intDrw = 5, "Q")
'accept RndNum iif it's in the list in Col, then test for no dupes
intUniq = 1
DoOVER:
Do
'''double rnd to start at different areas in UniqNums array
rndstart = Format((Rnd() * 0.31) * 100, "00")
intrndstart = CInt(rndstart)
intUniq = intrndstart + 1
x = Format((Rnd() * 0.39) * 100, "00")
LastCol = "K" & CStr(intUniq)
intUniq = intUniq + 1
If intUniq > 27 Then '''chng to 26 from 30
intUniq = 1
End If
''''embed a check here/perhaps send to sub w/more bias checks
If x = 0 Then
GoTo DoOVER
End If
Loop Until x = Range(LastCol).Value
sCol = ColRef & CStr(NumDy)
Range(sCol).Value = x
If intD5rw > 1 Then
ChkRef = Switch(intDrw = 2, "M", intDrw = 3, "N", intDrw = 4, "O", intDrw = 5, "P")
strDblChk = ChkRef & CStr(NumDy)
If Range(strDblChk).Value = Range(sCol).Value Then
GoTo DoOVER
ElseIf intDrw = 3 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 3 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 4 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 4 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("P" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("O" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
End If
End If
intDrw = intDrw + 1
Loop Until intDrw > 5
Val1 = Range("M" & CStr(NumDy) & "").Value
Val2 = Range("N" & CStr(NumDy) & "").Value
Val3 = Range("O" & CStr(NumDy) & "").Value
Val4 = Range("P" & CStr(NumDy) & "").Value
Val5 = Range("Q" & CStr(NumDy) & "").Value
For a = 1 To 5
ValX = Switch(a = 1, Val1, a = 2, Val2, a = 3, Val3, a = 4, Val4, a = 5, Val5)
ArNums(a) = ValX
Next
a = a - 1
Call BubbleSort(ArNums())
Range("Q" & CStr(NumDy) & "").Value = ArNums(a)
Range("P" & CStr(NumDy) & "").Value = ArNums(a - 1)
Range("O" & CStr(NumDy) & "").Value = ArNums(a - 2)
Range("N" & CStr(NumDy) & "").Value = ArNums(a - 3)
Range("M" & CStr(NumDy) & "").Value = ArNums(a - 4)
If Range("M" & CStr(NumDy) & "").Value = Range("N" & CStr(NumDy) & "").Value Then
intDrw = 1
GoTo DoOVER
ElseIf Range("N" & CStr(NumDy) & "").Value = Range("O" & CStr(NumDy) & "").Value Then
intDrw = 2
GoTo DoOVER
ElseIf Range("O" & CStr(NumDy) & "").Value = Range("P" & CStr(NumDy) & "").Value Then
intDrw = 3
GoTo DoOVER
ElseIf Range("P" & CStr(NumDy) & "").Value = Range("Q" & CStr(NumDy) & "").Value Then
intDrw = 4
GoTo DoOVER
End If
NumDy = NumDy + 1
Loop Until NumDy > 5
MsgBox "done"
End Sub
'borrowed this from John Walkenbach, a writer of great Excel books
Sub BubbleSort(list() As Integer)
Dim First As Integer, Last As Integer, i As Integer, j As Integer, temp
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub
Comments
Post a Comment
Please Log In
To use this feature you must be logged into your Lottery Post account.
Not a member yet?
If you don't yet have a Lottery Post account, it's simple and free to create one! Just tap the Register button and after a quick process you'll be part of our lottery community.
Register