B
Barry
Crossword Puzzle and Lottery Ticket.. Excel 2002. How to Do? Templates
Available? Thanks Barry
Available? Thanks Barry
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
J
Jim Cone
I have VBA code that generates California state Super Lotto and
Mega Millions numbers. Puts them on a worksheet with some
nice formatting. The numbers are randomly generated and provide
winning numbers as often as any other system. <g>
I can post the code if anyone wants it.
Check out the free Excel add-in "Display Word Permutations"
if you want to breeze through the "Jumble" puzzle. It is at ...
http://www.realezsites.com/bus/primitivesoftware
--
Jim Cone
San Francisco, USA
"Barry" <[email protected]>
wrote in message
Crossword Puzzle and Lottery Ticket.. Excel 2002.
How to Do? Templates Available?
Thanks Barry
Mega Millions numbers. Puts them on a worksheet with some
nice formatting. The numbers are randomly generated and provide
winning numbers as often as any other system. <g>
I can post the code if anyone wants it.
Check out the free Excel add-in "Display Word Permutations"
if you want to breeze through the "Jumble" puzzle. It is at ...
http://www.realezsites.com/bus/primitivesoftware
--
Jim Cone
San Francisco, USA
"Barry" <[email protected]>
wrote in message
Crossword Puzzle and Lottery Ticket.. Excel 2002.
How to Do? Templates Available?
Thanks Barry
M
Max
Jim Cone said:I have VBA code that generates California state Super Lotto and
Mega Millions numbers. Puts them on a worksheet with some
nice formatting. The numbers are randomly generated and provide
winning numbers as often as any other system. <g>
I can post the code if anyone wants it.
Jim, would love to see your code
Thanks
---
J
Jim Cone
Max,
But you are not in California - anyway I get 10% of the winnings. <g>
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'------------------------------------------------------------------------
'Jun 14, 2003 - Created by Jim Cone - San Francisco, USA
'Generates from 1 to 10 sets of California lotto numbers.
'------------------------------------------------------------------------
Sub GetLottoNumbers()
On Error GoTo ErrInNumber
Dim strDefault As String
Dim strUserNumber As String
Dim AlreadyTried As Boolean
Dim blnMegaM As Boolean
If ActiveSheet Is Nothing Then Exit Sub
strDefault = " 5 "
StartAgain:
Application.Cursor = xlDefault
strUserNumber = InputBox("Enter the number of lottery entries." & vbCr & _
"(must be 10 or less)" & vbCr & "Press Shift key for Mega Millions", _
" California Lottery Numbers ", strDefault)
blnMegaM = GetKeyState(16) < 0
DoEvents 'Ensure input box image disappears
If Len(strUserNumber) = 0 Then
Exit Sub
Else
If (Val(strUserNumber)) < 1 Or Val(strUserNumber) > 10 Then
If AlreadyTried Then Exit Sub
AlreadyTried = True
strDefault = " Your entry must be a number between 1 and 10 "
GoTo StartAgain
Else
ShuffleArrayValues Val(strUserNumber), blnMegaM
End If
End If
Exit Sub
ErrInNumber:
Beep
Application.ScreenUpdating = True
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCr & _
"Contact the programs author (James Cone) if the problem persists. ", _
vbCritical, " California Lotto Numbers"
End Sub
'==================================================
' GetBottomRow() Function
' Called by ShuffleArrayValues.
' Returns the number of the last worksheet row with data.
'==================================================
Function GetBottomRow(ByRef objSht As Excel.Worksheet) As Long
On Error GoTo NoRow
GetBottomRow = objSht.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Exit Function
NoRow:
GetBottomRow = 0
End Function
'=========================================
' MaxShtNum() Function
' Created May 05, 2001 by Jim Cone - San Francisco, USA
' Called by ShuffleArrayValues.
' Returns a number between 0 and 100.
'=========================================
Function MaxShtNum() As Long
On Error GoTo BadSheet
Dim Sht As Object
Dim N As Double
For Each Sht In ActiveWorkbook.Sheets
N = WorksheetFunction.Max(N, Val(Right$(Sht.Name, 2)))
Next 'Sht
MaxShtNum = N + 1
Set Sht = Nothing
Exit Function
BadSheet:
MaxShtNum = 0
Set Sht = Nothing
End Function
'====================================================
'Jun 14, 2003 - Created by Jim Cone - San Francisco, USA
'Jun 23, 2005 - Last Update
'Called by Sub "GetLottoNumbers".
'Requires Functions MaxShtNum and GetBottomRow.
'====================================================
Sub ShuffleArrayValues(ByVal HowMany As Long, ByRef blnM As Boolean)
Dim i As Long
Dim j As Long
Dim lngCol As Long
Dim lngRow As Long
Dim lngMega As Integer
Dim lngValue As Integer
Dim ArrBig() As Integer
Dim ArrSmall(1 To 5, 1 To 1) As Integer
Application.ScreenUpdating = False
i = MaxShtNum
If blnM Then
lngValue = 56 'Mega Millions
lngMega = 46
Else
lngValue = 47 'Super Lotto
lngMega = 27
End If
If GetBottomRow(ActiveSheet) = 0 Then 'A blank sheet
On Error Resume Next
'Leave a space at end of name so last 2 characters can be read as a number.
ActiveSheet.Name = "California Lottery Numbers " & i
On Error GoTo 0
lngRow = 5
ElseIf Not ActiveSheet.Name Like "*California Lottery Numbers*" Then
Worksheets.Add Before:=ActiveSheet, Count:=1
On Error Resume Next
ActiveSheet.Name = "California Lottery Numbers " & i
On Error GoTo 0
lngRow = 5
Else
lngRow = Cells(Rows.Count, 2).End(xlUp).Row + 3
'Extra rows required for the array
If lngRow + 7 > Rows.Count Then
Application.Cursor = xlDefault
MsgBox "Have run out of rows. ", vbExclamation, " California Lottery Numbers"
Exit Sub
End If
End If
For lngCol = 3 To (HowMany + 2)
j = 1
ReDim ArrBig(1 To lngValue)
Do While j < 6
Randomize (Right(Timer, 2) * j)
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
i = Int(Rnd * lngValue + 1)
If ArrBig(i) <> 99 Then
ArrSmall(j, 1) = i
ArrBig(i) = 99
j = j + 1
End If
Loop
'Add array values to the worksheet.
With Range(Cells(lngRow, lngCol), Cells(lngRow + 4, lngCol))
.Value = ArrSmall()
.Sort key1:=Cells(lngRow, lngCol)
End With
'Get another random number ("Mega") and add to worksheet.
Randomize (Right(Timer, 2) * lngCol)
Cells(lngRow + 6, lngCol).Value = Int((Rnd * lngMega) + 1)
Erase ArrBig
Erase ArrSmall
Next 'lngCol
'Format the new worksheet.
Rows(lngRow + 6).VerticalAlignment = xlTop
With Range(Cells(lngRow, 2), Cells(lngRow + 6, lngCol - 1))
.RowHeight = ActiveSheet.StandardHeight + 2
.Interior.Color = vbWhite
.HorizontalAlignment = xlCenter
.Columns.ColumnWidth = ActiveSheet.StandardWidth - 1
.BorderAround LineStyle:=xlContinuous
With .Borders(xlInsideVertical)
.LineStyle = xlDash
.Weight = xlHairline
End With
End With
With Range(Cells(lngRow, 2), Cells(lngRow + 6, 2))
.Interior.ColorIndex = 15
.Font.Bold = True
If blnM Then 'Mega Millions
.Value = WorksheetFunction.Transpose _
(Array("M", "E", "G", "A", "Millions", "", "MEGA"))
Else
.Value = WorksheetFunction.Transpose _
(Array("L", "O", "T", "T", "O", "", "MEGA"))
End If
End With
Columns(1).ColumnWidth = ActiveSheet.StandardWidth \ 2
With Range("B2")
If Len(.Value) = 0 Then .Value = "Lottery Numbers Created on " & Date
End With
Do While ActiveWindow.VisibleRange.Rows _
(ActiveWindow.VisibleRange.Rows.Count).Row < lngRow + 7
ActiveWindow.ScrollRow = ActiveWindow.VisibleRange.Row + 1
Loop
Application.ScreenUpdating = True
End Sub
'------------------
"Max" <[email protected]>
wrote in message
Jim, would love to see your code
Thanks
But you are not in California - anyway I get 10% of the winnings. <g>
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'------------------------------------------------------------------------
'Jun 14, 2003 - Created by Jim Cone - San Francisco, USA
'Generates from 1 to 10 sets of California lotto numbers.
'------------------------------------------------------------------------
Sub GetLottoNumbers()
On Error GoTo ErrInNumber
Dim strDefault As String
Dim strUserNumber As String
Dim AlreadyTried As Boolean
Dim blnMegaM As Boolean
If ActiveSheet Is Nothing Then Exit Sub
strDefault = " 5 "
StartAgain:
Application.Cursor = xlDefault
strUserNumber = InputBox("Enter the number of lottery entries." & vbCr & _
"(must be 10 or less)" & vbCr & "Press Shift key for Mega Millions", _
" California Lottery Numbers ", strDefault)
blnMegaM = GetKeyState(16) < 0
DoEvents 'Ensure input box image disappears
If Len(strUserNumber) = 0 Then
Exit Sub
Else
If (Val(strUserNumber)) < 1 Or Val(strUserNumber) > 10 Then
If AlreadyTried Then Exit Sub
AlreadyTried = True
strDefault = " Your entry must be a number between 1 and 10 "
GoTo StartAgain
Else
ShuffleArrayValues Val(strUserNumber), blnMegaM
End If
End If
Exit Sub
ErrInNumber:
Beep
Application.ScreenUpdating = True
MsgBox "Error " & Err.Number & " - " & Err.Description & vbCr & _
"Contact the programs author (James Cone) if the problem persists. ", _
vbCritical, " California Lotto Numbers"
End Sub
'==================================================
' GetBottomRow() Function
' Called by ShuffleArrayValues.
' Returns the number of the last worksheet row with data.
'==================================================
Function GetBottomRow(ByRef objSht As Excel.Worksheet) As Long
On Error GoTo NoRow
GetBottomRow = objSht.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Exit Function
NoRow:
GetBottomRow = 0
End Function
'=========================================
' MaxShtNum() Function
' Created May 05, 2001 by Jim Cone - San Francisco, USA
' Called by ShuffleArrayValues.
' Returns a number between 0 and 100.
'=========================================
Function MaxShtNum() As Long
On Error GoTo BadSheet
Dim Sht As Object
Dim N As Double
For Each Sht In ActiveWorkbook.Sheets
N = WorksheetFunction.Max(N, Val(Right$(Sht.Name, 2)))
Next 'Sht
MaxShtNum = N + 1
Set Sht = Nothing
Exit Function
BadSheet:
MaxShtNum = 0
Set Sht = Nothing
End Function
'====================================================
'Jun 14, 2003 - Created by Jim Cone - San Francisco, USA
'Jun 23, 2005 - Last Update
'Called by Sub "GetLottoNumbers".
'Requires Functions MaxShtNum and GetBottomRow.
'====================================================
Sub ShuffleArrayValues(ByVal HowMany As Long, ByRef blnM As Boolean)
Dim i As Long
Dim j As Long
Dim lngCol As Long
Dim lngRow As Long
Dim lngMega As Integer
Dim lngValue As Integer
Dim ArrBig() As Integer
Dim ArrSmall(1 To 5, 1 To 1) As Integer
Application.ScreenUpdating = False
i = MaxShtNum
If blnM Then
lngValue = 56 'Mega Millions
lngMega = 46
Else
lngValue = 47 'Super Lotto
lngMega = 27
End If
If GetBottomRow(ActiveSheet) = 0 Then 'A blank sheet
On Error Resume Next
'Leave a space at end of name so last 2 characters can be read as a number.
ActiveSheet.Name = "California Lottery Numbers " & i
On Error GoTo 0
lngRow = 5
ElseIf Not ActiveSheet.Name Like "*California Lottery Numbers*" Then
Worksheets.Add Before:=ActiveSheet, Count:=1
On Error Resume Next
ActiveSheet.Name = "California Lottery Numbers " & i
On Error GoTo 0
lngRow = 5
Else
lngRow = Cells(Rows.Count, 2).End(xlUp).Row + 3
'Extra rows required for the array
If lngRow + 7 > Rows.Count Then
Application.Cursor = xlDefault
MsgBox "Have run out of rows. ", vbExclamation, " California Lottery Numbers"
Exit Sub
End If
End If
For lngCol = 3 To (HowMany + 2)
j = 1
ReDim ArrBig(1 To lngValue)
Do While j < 6
Randomize (Right(Timer, 2) * j)
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
i = Int(Rnd * lngValue + 1)
If ArrBig(i) <> 99 Then
ArrSmall(j, 1) = i
ArrBig(i) = 99
j = j + 1
End If
Loop
'Add array values to the worksheet.
With Range(Cells(lngRow, lngCol), Cells(lngRow + 4, lngCol))
.Value = ArrSmall()
.Sort key1:=Cells(lngRow, lngCol)
End With
'Get another random number ("Mega") and add to worksheet.
Randomize (Right(Timer, 2) * lngCol)
Cells(lngRow + 6, lngCol).Value = Int((Rnd * lngMega) + 1)
Erase ArrBig
Erase ArrSmall
Next 'lngCol
'Format the new worksheet.
Rows(lngRow + 6).VerticalAlignment = xlTop
With Range(Cells(lngRow, 2), Cells(lngRow + 6, lngCol - 1))
.RowHeight = ActiveSheet.StandardHeight + 2
.Interior.Color = vbWhite
.HorizontalAlignment = xlCenter
.Columns.ColumnWidth = ActiveSheet.StandardWidth - 1
.BorderAround LineStyle:=xlContinuous
With .Borders(xlInsideVertical)
.LineStyle = xlDash
.Weight = xlHairline
End With
End With
With Range(Cells(lngRow, 2), Cells(lngRow + 6, 2))
.Interior.ColorIndex = 15
.Font.Bold = True
If blnM Then 'Mega Millions
.Value = WorksheetFunction.Transpose _
(Array("M", "E", "G", "A", "Millions", "", "MEGA"))
Else
.Value = WorksheetFunction.Transpose _
(Array("L", "O", "T", "T", "O", "", "MEGA"))
End If
End With
Columns(1).ColumnWidth = ActiveSheet.StandardWidth \ 2
With Range("B2")
If Len(.Value) = 0 Then .Value = "Lottery Numbers Created on " & Date
End With
Do While ActiveWindow.VisibleRange.Rows _
(ActiveWindow.VisibleRange.Rows.Count).Row < lngRow + 7
ActiveWindow.ScrollRow = ActiveWindow.VisibleRange.Row + 1
Loop
Application.ScreenUpdating = True
End Sub
'------------------
"Max" <[email protected]>
wrote in message
Jim Cone said:I have VBA code that generates California state Super Lotto and
Mega Millions numbers. Puts them on a worksheet with some
nice formatting. The numbers are randomly generated and provide
winning numbers as often as any other system. <g>
I can post the code if anyone wants it.
Jim, would love to see your code
Thanks
M
Max
Max,
But you are not in California - anyway I get 10% of the winnings. <g>
Many thanks, Jim. Sheer magic. Great "potential" <g>.
Ah, no prob on the 10%. I'll send it pronto if Event* =TRUE
*applied to the local lotto here, which is a pick 6 out of 45 num
---
Ask a Question
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.