Using Excel 2000
Hi,
@johnnyL, I found your code which work perfect with my version 2000 as it is designed. Please does it is possible could be adapted for the lottery Euromillones 5_50 “5 balls out of 50”
Also I need bit more specific Odd/Even condition by their “5 positions” to generate the combinations. Conditions simple sheet with 3 examples is attached below.
@johnnyL, code from below link.
Excel List All Lottery Combinations - 2441
Thank you in advance
Regards,
Kishan
Hi,
@johnnyL, I found your code which work perfect with my version 2000 as it is designed. Please does it is possible could be adapted for the lottery Euromillones 5_50 “5 balls out of 50”
Also I need bit more specific Odd/Even condition by their “5 positions” to generate the combinations. Conditions simple sheet with 3 examples is attached below.
| Kishan Index.xlsx | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | |||
| 1 | ||||||||||
| 2 | Position-1 | Position-2 | Position-3 | Position-4 | Position-5 | |||||
| 3 | Example1 | ODD | ODD | ODD | ODD | ODD | ||||
| 4 | Out Put | 1 | 3 | 5 | 7 | 9 | ||||
| 5 | ||||||||||
| 6 | Position-1 | Position-2 | Position-3 | Position-4 | Position-5 | |||||
| 7 | Example2 | EVEN | ODD | ODD | EVEN | EVEN | ||||
| 8 | Out Put | 2 | 9 | 15 | 48 | 50 | ||||
| 9 | ||||||||||
| 10 | Position-1 | Position-2 | Position-3 | Position-4 | Position-5 | |||||
| 11 | Example3 | EVEN | EVEN | EVEN | ODD | ODD | ||||
| 12 | Out Put | 2 | 12 | 22 | 39 | 49 | ||||
| 13 | ||||||||||
Hoja15 | ||||||||||
@johnnyL, code from below link.
Excel List All Lottery Combinations - 2441
VBA Code:
Sub ListThemAllViaArray()
'
Dim ArraySlotCount As Long
Dim Ball_1 As Long, Ball_2 As Long, Ball_3 As Long, Ball_4 As Long, Ball_5 As Long, Ball_6 As Long
Dim CombinationCounter As Long
Dim MaxRows As Long, ThisRow As Long
Dim MaxWhiteBallValue As Long
Dim TotalExpectedCominations As Long
Dim ThisColumn As Long
Dim CombinationsArray(1 To 65536) As Variant
'
MaxWhiteBallValue = 44 ' <--- Set to highest value of white ball
'
ArraySlotCount = 0 ' Initialize ArraySlotCount
CombinationCounter = 1 ' Initialize CombinationCounter
MaxRows = 65536 ' Set to maximum number of slots in Array
ThisColumn = 1 ' Initialize 1st column to display results in
ThisRow = 0 ' Initialize row counter
TotalExpectedCominations = 7059052 ' Set expected # of total combinations
'
Application.ScreenUpdating = False ' Turn Screen Updating off
'
For Ball_1 = 1 To MaxWhiteBallValue - 5 ' Establish loop for 1st ball
For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 4 ' Establish loop for 2nd ball
For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 3 ' Establish loop for 3rd ball
For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 2 ' Establish loop for 4th ball
For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue - 1 ' Establish loop for 5th ball
For Ball_6 = (Ball_5 + 1) To MaxWhiteBallValue ' Establish loop for 6th ball
'
ArraySlotCount = ArraySlotCount + 1 ' Increment ArraySlotCount
'
' Save combination into array
CombinationsArray(ArraySlotCount) = Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & "-" & Ball_5 & "-" & Ball_6
CombinationCounter = CombinationCounter + 1 ' Increment CombinationCounter
'
If CombinationCounter Mod 550000 = 0 Then ' If CombinationCounter = 550k then ...
' Update StatusBar about every 10 seconds
Application.StatusBar = "Result " & CombinationCounter & " on way to " & TotalExpectedCominations
'
DoEvents ' DoEvents
End If
'
ThisRow = ThisRow + 1 ' Increment row counter
'
If ThisRow = MaxRows Then ' If row count=array max slots
' Dump contents of CombinationsArray to the screen
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray)
'
Erase CombinationsArray ' Erase contents of array
ArraySlotCount = 0 ' Reset ArraySlotCount
ThisRow = 0 ' Reset row counter
ThisColumn = ThisColumn + 1 ' Increment column counter
End If
Next
Next
Next
Next
Next
Next
'
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray) ' Dump contents of last array to the screen
Columns.AutoFit ' Resize all columns to fit the data within them
'
Application.ScreenUpdating = True ' Turn Screen Updating back on
End SubThank you in advance
Regards,
Kishan
