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 LastRowOfNumbers As Long
Dim MaxRows As Long, ThisRow As Long
Dim MaxNumberOfBalls As Long
Dim NumberOfBallsToBeDrawnEachDraw As Long
Dim StartRowOfNumbers As Long
Dim TotalExpectedCominations As Long
Dim ResultsStartColumn As Long
Dim CombinationsArray(1 To 65536) As Variant
Dim MyNumbersArray As Variant
Dim wsSource As Worksheet
'
Set wsSource = Sheets("Sheet1") ' <--- Set this to sheet that contains your numbers
StartRowOfNumbers = 1 ' <--- Set this to the start row of your numbers
NumberOfBallsToBeDrawnEachDraw = 6 ' <--- Set this to the NumberOfBallsToBeDrawnEachDraw
ResultsStartColumn = 2 ' <--- Set this to the column # to display results in
'
LastRowOfNumbers = wsSource.Range("A" & Rows.Count).End(xlUp).Row ' Get last used row of numbers
'
MyNumbersArray = wsSource.Range("A" & StartRowOfNumbers & ":A" & LastRowOfNumbers) ' Load numbers into 2D 1 based array RC
'
'' MaxNumberOfBalls = 44 ' Total number of balls
MaxNumberOfBalls = LastRowOfNumbers - StartRowOfNumbers + 1 ' Total number of balls
'
ArraySlotCount = 0 ' Initialize ArraySlotCount
CombinationCounter = 1 ' Initialize CombinationCounter
MaxRows = 65536 ' Set to maximum number of slots in Array
ThisRow = 0 ' Initialize row counter
TotalExpectedCominations = Application.Combin(MaxNumberOfBalls, NumberOfBallsToBeDrawnEachDraw) ' Set expected # of total combinations
'
Application.ScreenUpdating = False ' Turn Screen Updating off
'
For Ball_1 = 1 To MaxNumberOfBalls - 5 ' Establish loop for 1st ball
For Ball_2 = (Ball_1 + 1) To MaxNumberOfBalls - 4 ' Establish loop for 2nd ball
For Ball_3 = (Ball_2 + 1) To MaxNumberOfBalls - 3 ' Establish loop for 3rd ball
For Ball_4 = (Ball_3 + 1) To MaxNumberOfBalls - 2 ' Establish loop for 4th ball
For Ball_5 = (Ball_4 + 1) To MaxNumberOfBalls - 1 ' Establish loop for 5th ball
For Ball_6 = (Ball_5 + 1) To MaxNumberOfBalls ' Establish loop for 6th ball
'
ArraySlotCount = ArraySlotCount + 1 ' Increment ArraySlotCount
'
' Save combination into array
CombinationsArray(ArraySlotCount) = MyNumbersArray(Ball_1, 1) & "-" & MyNumbersArray(Ball_2, 1) & "-" & MyNumbersArray(Ball_3, 1) & "-" & MyNumbersArray(Ball_4, 1) & "-" & MyNumbersArray(Ball_5, 1) & "-" & MyNumbersArray(Ball_6, 1)
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
wsSource.Range(Cells(1, ResultsStartColumn), wsSource.Cells(ThisRow, ResultsStartColumn)) = Application.Transpose(CombinationsArray)
'
Erase CombinationsArray ' Erase contents of array
ArraySlotCount = 0 ' Reset ArraySlotCount
ThisRow = 0 ' Reset row counter
ResultsStartColumn = ResultsStartColumn + 1 ' Increment column counter
End If
Next
Next
Next
Next
Next
Next
'
Range(Cells(1, ResultsStartColumn), Cells(ThisRow, ResultsStartColumn)) = Application.Transpose(CombinationsArray) ' Dump contents of last array to screen
'
Columns.AutoFit ' Resize all columns to fit the data within them
Application.ScreenUpdating = True ' Turn Screen Updating back on
End Sub
That would be 17*17*17*17*17*17
