Private Sub cmdGenRandomNumsFromPool_Click() ' Author: Jason Morris ' Date Created: 01/15/2009 ' Description: This is to randomly draw five sets of lotto numbers based on the numbers available ' in the number pools. This will generate numbers as they would appear on a lotto ' ticket (but only using select one digits). ' === Defines Variables === Dim Ball1 As Integer ' Obtains Ball number 1 Dim Ball2 As Integer ' Obtains Ball number 2 Dim Ball3 As Integer ' Obtains Ball number 3 Dim Ball4 As Integer ' Obtains Ball number 4 Dim Ball5 As Integer ' Obtains Ball number 5 Dim Sball_row As Integer ' Sets the Row to update for the Standard Ball Dim Ticket_Row As Integer ' Keeps track of which row the ticket is entered Dim Ticket_Row_Dflt As Integer ' The Default start row for Ticket_Row Dim Ball_rnd_num As Integer ' Variable for the how many random numbers to pick from Dim PBall_rnd_num As Integer ' Variable for the how many random numbers to pick a PowerBall from Dim Data_Source As String ' Used to store the name of the source tab Dim Data_Output As String ' Used to store the name of the output tab ' === Initialize Variables === Ticket_Row_Dflt = 14 Data_Source = "Number Generator" Data_Output = "Number Generator" Ball_rnd_num = 0 PBall_rnd_num = 0 ' === Determine Numbers in General Pool === ' Calculate how many numbers are in the general pool. This is done by adding 2 to the ball_rnd_num. ' This method avoids accounting for the header and also avoids having to subtract 1 from rnd_num ' once the loop completes. Do Until ThisWorkbook.Worksheets(Data_Source).Cells(Ball_rnd_num + 2, 9).Value = "" Ball_rnd_num = Ball_rnd_num + 1 Loop ' Below IF statement verifies 6 or more regular balls are in the pool. If Ball_rnd_num < 6 Then MsgBox "Must have at least 6 Regular Balls in the Pool!", vbExclamation, "Lotto Numbers" GoTo End_Generator End If ' === Determine Numbers in PowerBall Pool === ' Calculate how many numbers are in the PowerBall pool. This is done by adding 2 to the PBall_rnd_num. ' This method avoids accounting for the header and also avoids having to subtract 1 from rnd_num ' once the loop completes. Do Until ThisWorkbook.Worksheets(Data_Source).Cells(PBall_rnd_num + 2, 11).Value = "" PBall_rnd_num = PBall_rnd_num + 1 Loop ' Below IF statement verifies 5 or more power balls are in the pool. If PBall_rnd_num < 1 Then MsgBox "Must have at least 1 Power Ball in the Pool!", vbExclamation, "Lotto Numbers" GoTo End_Generator End If ' === Clears the Tickets === Ticket_Row = Ticket_Row_Dflt ' Sets to the first Ticket_Row Do Until Ticket_Row > 18 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 2).Value = "" ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 3).Value = "" ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 4).Value = "" ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 5).Value = "" ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 6).Value = "" ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 7).Value = "" ' Increments the Ticket_Row Variable Ticket_Row = Ticket_Row + 1 Loop ' ************************************* ' *** Start of Main Processing Loop *** ' ************************************* Ticket_Row = Ticket_Row_Dflt ' Resets to the first Ticket_Row Do Until Ticket_Row > 18 ' === Reset the Balls === Ball1 = 0 Ball2 = 0 Ball3 = 0 Ball4 = 0 Ball5 = 0 PowerBall = 0 ' === Pick Ball1 === Ball1 = Int(Ball_rnd_num * Rnd + 1) ' === Pick Ball2 === ' Loops to ensure it is not equal to any previous ball drawn. Ball2 = Int(Ball_rnd_num * Rnd + 1) Do Until Ball2 <> Ball1 Ball2 = Int(Ball_rnd_num * Rnd + 1) Loop ' === Pick Ball3 === ' Loops to ensure it is not equal to any previous ball drawn. Ball3 = Int(Ball_rnd_num * Rnd + 1) Do Until Ball3 <> Ball1 And Ball3 <> Ball2 Ball3 = Int(Ball_rnd_num * Rnd + 1) Loop ' === Pick Ball4 === ' Loops to ensure it is not equal to any previous ball drawn. Ball4 = Int(Ball_rnd_num * Rnd + 1) Do Until Ball4 <> Ball1 And Ball4 <> Ball2 And Ball4 <> Ball3 Ball4 = Int(Ball_rnd_num * Rnd + 1) Loop ' === Pick Ball5 === ' Loops to ensure it is not equal to any previous ball drawn. Ball5 = Int(Ball_rnd_num * Rnd + 1) Do Until Ball5 <> Ball1 And Ball5 <> Ball2 And Ball5 <> Ball3 And Ball5 <> Ball4 Ball5 = Int(Ball_rnd_num * Rnd + 1) Loop ' === Pick PowerBall === PowerBall = Int(PBall_rnd_num * Rnd + 1) ' === Retrieve Balls from Side Panel === ' By adding 1 to the Ball value accounts for the header row. Ball1 = ThisWorkbook.Worksheets(Data_Source).Cells((1 + Ball1), 9).Value Ball2 = ThisWorkbook.Worksheets(Data_Source).Cells((1 + Ball2), 9).Value Ball3 = ThisWorkbook.Worksheets(Data_Source).Cells((1 + Ball3), 9).Value Ball4 = ThisWorkbook.Worksheets(Data_Source).Cells((1 + Ball4), 9).Value Ball5 = ThisWorkbook.Worksheets(Data_Source).Cells((1 + Ball5), 9).Value PowerBall = ThisWorkbook.Worksheets(Data_Source).Cells((1 + PowerBall), 11).Value ' === Display Balls Picked === ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 2).Value = Ball1 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 3).Value = Ball2 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 4).Value = Ball3 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 5).Value = Ball4 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 6).Value = Ball5 ThisWorkbook.Worksheets(Data_Output).Cells(Ticket_Row, 7).Value = PowerBall ' === Sort the Standard Balls Low to High === Range("B" & Ticket_Row & ":F" & Ticket_Row).Select Selection.Sort Key1:=Range("B" & Ticket_Row), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _ DataOption1:=xlSortNormal ' Increments the Ticket_Row Variable Ticket_Row = Ticket_Row + 1 Loop ' *********************************** ' *** End of Main Processing Loop *** ' *********************************** ' === Returns focus to the top of the spreadsheet === ThisWorkbook.Worksheets(Data_Output).Range("A1").Select ' === Display Completed Message === MsgBox "Numbers have been generated from " & Ball_rnd_num & " possible balls and " & PBall_rnd_num & " possible Power Balls", vbInformation, "Lotto Numbers" End_Generator: End Sub