Lottery Combinations Filter

[kingofhartz77]

Hi All,

I have modified a VBA script (below) posted by JohnnyL to give me all possible combinations of 6 numbers from 39. I would now please like some help to filter the following out but I don't even know where to start as I am not a programmer:

1 - remove all combinations containing groups of 6, 5 and 4 consecutive numbers
2 - only allow one group of 3 consecutive numbers per combination of 6 numbers
3 - only allow a maximum of 2 groups containing 2 consecutive numbers in each combination of 6 numbers (groups need to be separated by at least one number)

Sub List6of39ViaArray()
'
    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 ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ThisRow                         As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 6                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 39                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ThisRow = 0                                                                                             ' Initialize row counter
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' 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                                          '               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, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 6) = Ball_6                                   '                       Save ball number to array
'
                            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 + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ThisRow = 0                                                                 '                           Reset row counter
                                ThisColumn = ThisColumn + ColumnIncrement                                   '                           Increment column counter
                            End If
                        Next
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray           ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub

Regards,

Henry

 

[Exo]

I have made code for rule 1, please check it out.
Easyupload.io - Upload Files and Share Them Easily

 

[Fluff]

@Exo Please post your code to the site, as per Rule#4 Thanks.