Comment #2

LottoMining — Fri, 18 Mar 2011 12:38:07 GMT

You're welcome; hope you win with it.

Comment #1

budward — Thu, 17 Mar 2011 15:11:53 GMT

thanks LottoMining! I've already adapted it to my style and am going to start using it for predictions tomorrow to see what happens.

Original Blog Entry: Excel VBA script to generate a list of 5 randomized draws (forum requested)

LottoMining — Thu, 17 Mar 2011 03:02:27 GMT

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

... [ More ]