Re: Actual Lottery Stuff. WOW eh?

"Michael Harrington" <mikharr@xxxxxxxxxxx> wrote in message
news:44ca7a04$0$23676$5a62ac22@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

"Abraxas" <dontbother@xxxxxxxxxx> wrote in message
news:44ca3d56$0$30609$88260bb3@xxxxxxxxxxxxxxxxxxxx
"Michael Harrington" <mikharr@xxxxxxxxxxx> wrote in message
news:44c9d5e2$0$23677$5a62ac22@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx



This generates and stores 1,000,000 quick picks with
no duplicates. It then prints the first 30 to screen converting
index numbers into actual 6/49 lotto tickets. Takes about
6 seconds on my machine.

Private Sub Command1_Click()


Dim Barrel(1 To 13983816) As Long, i As Long
Dim j As Long, pick As Long, drawn As Long
Dim a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, iter As Long
Dim Chosen(1 To 13983816) As Boolean



For i = 1 To 13983816
Barrel(i) = i

Next i

For j = 13983816 To 1283816 Step -1 ' we can lower this as desired
drawn = Int(Rnd * j) + 1
pick = Barrel(drawn)
Barrel(drawn) = Barrel(j)
Barrel(j) = pick
Chosen(pick) = True
'Print pick

Next j

i = 0
For a = 1 To 44
For b = a + 1 To 45
For c = b + 1 To 46
For d = c + 1 To 47
For e = d + 1 To 48
For f = e + 1 To 49
i = i + 1
If Chosen(i) = True And iter < 30 Then
Print a, b, c, d, e, f
iter = iter + 1
End If

Next f, e, d, c, b, a

Print i 'check for 13983816

End Sub


Thanks again Michael. I incorporated much of your code into some existing
code of my own...with a few modifications here & there. Result? A pretty
handy little app that will generate any quantity of random lines requested
by the user (with no duplicates--verified!) and save them to a text file.
Pretty darn quick too...over 11,000 lines a second on my machine. Producing
the fabled 9,841,209 random lines takes a little over 14 minutes. (3 ghz
cpu, 1 gig RAM, XP)

Private Sub Command1_Click()

Dim Barrel(1 To 13983816) As Long, i As Long
Dim j As Long, pick As Long, drawn As Long, k As Long
Dim cnt As Long
Dim z1 As Long 'I find long is always faster than integer
Dim z2 As Long
Dim z3 As Long
Dim z4 As Long
Dim z5 As Long
Dim z6 As Long
Dim Chosen(1 To 13983816) As Boolean 'arrays are your best friend

Label2.Visible = False 'hide until finished

cdlFiles.FileName = ""
cdlFiles.Filter = "Text Files (*.txt)|*.txt"
cdlFiles.DefaultExt = "txt"
cdlFiles.DialogTitle = "Save Wheel File"
cdlFiles.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist +
cdlOFNHideReadOnly + cdlOFNNoChangeDir
cdlFiles.InitDir = App.Path
cdlFiles.ShowSave
If cdlFiles.FileName = "" Then
Exit Sub
End If

Me.Refresh

rpicks = InputBox("How many random picks would you like?")
If rpicks = vbNullString Then
Me.Refresh
Exit Sub
End If
rpicks = (13983816 - rpicks) + 1 ' variable quantity input by user

Open cdlFiles.FileName For Output As #1

MousePointer = vbHourglass
k = 0 'counter for label

For i = 1 To 13983816
Barrel(i) = i
Next i

For j = 13983816 To rpicks Step -1 ' allows the user to specify quantity
required
DoEvents
Randomize ' without this it produces the same lines every time
drawn = Int(Rnd * j) + 1
pick = Barrel(drawn)
Barrel(drawn) = Barrel(j)
Barrel(j) = pick
Chosen(pick) = True
Next j

cnt = 0 'counter

For z1 = 1 To 44
For z2 = (z1 + 1) To 45
For z3 = (z2 + 1) To 46
For z4 = (z3 + 1) To 47
For z5 = (z4 + 1) To 48
For z6 = (z5 + 1) To 49
DoEvents
cnt = cnt + 1
If Chosen(cnt) = True Then

rline = z1 & " " & z2 & " " & z3 & " " & z4 & " " & z5 & " " & z6 ' I need a
space delimiter

'Debug.Print rline

Print #1, rline ' saves the line to the specified text file

k = k + 1
Label1 = k 'label on form shows count
Label1.Refresh

End If

Next z6
Next z5
Next z4
Next z3
Next z2
Next z1

'Debug.Print cnt
Close 1
Label2.Visible = True 'says Finished
MousePointer = vbNormal
End Sub

All you need to do is drop a common dialog tool on the form and name it
"cdlFiles". Also 2 labels and the command button. I could mail you the
project file or the compiled app if you'd like. The .exe is only 24K.

Kind Regards, Paul




--
Posted via a free Usenet account from http://www.teranews.com

.