all lottery combinations 1 - 49

[damainman]

i need excel to output all lottery combinations. the numbers are from 1-49 from which 6 numbers are drawn. i do realise the number of combinations are 13983816. i want the 6 numbers drawn to be in different cells across 6 different columns. so the 1st 6 numbers are in a1, b1, c1, d1, e1, f1. obviously excel 2003 has 65536 rows and so the formula/vb code should carry on onto a new worksheet or ideally a new workbook. its ideal in a new workbook so not to end up with a single huge 10gig file, but on several worksheets in 1 workbook is fine.

i have been trying to do this myself for a while now with no success. any help would be great. from what i understand; this is a bit of a challenge i know.

 

[kalak]

Could anyone suggest please what should be changed in this code in order to get all possible 4 digit outcomes out of the total 20 let say. Change values of n & r basically. Thanks.

Do you mean this?

Sub qaq() 

Const v& = 4 'number of columns
Dim y(), u&, i&, j&
u = 20 'numbers
ReDim y(1 To u ^ v, 1 To v)

For j = 1 To v
    For i = 1 To u ^ v
        y(i, j) = 1 + Int((i - 1) / (u ^ (v - j))) Mod u
    Next i
Next j

[a1].Resize(u ^ v, v) = y


End Sub

 

[S.H.A.D.O.]

That produces 160,000 permutations, whereas there are 4,845 combinations.

 

[kalak]

That produces 160,000 permutations, whereas there are 4,845 combinations.

Ah! You want this?

Sub test()

Const u& = 20
Const v& = 4
Dim c(), y()
Dim i&, j&, r&, x&

ReDim y(1 To u ^ v, 1 To v), c(1 To u ^ v, 1 To v)
For j = 1 To v
    For i = 1 To u ^ v
        y(i, j) = 1 + Int((i - 1) / (u ^ (v - j))) Mod u
    Next i
Next j

For i = 1 To u ^ v
    For j = 2 To v
        If Not y(i, j) - y(i, j - 1) > 0 Then GoTo nxti
    Next j
    x = x + 1
    For j = 1 To v
        c(x, j) = y(i, j)
    Next j
nxti:
Next i

[a1].Resize(x, v).Value = c
End Sub

 

[kalak]

... or faster but somewhat less flexible is:

Sub test2()

Const u& = 20
Const v& = 4

Dim x(), a&, b&, c&, d&, k&
ReDim x(1 To Application.Combin(u, v), 1 To v)

For a = 1 To u
    For b = a + 1 To u
        For c = b + 1 To u
            For d = c + 1 To u
                k = k + 1
                x(k, 1) = a
                x(k, 2) = b
                x(k, 3) = c
                x(k, 4) = d
            Next d
        Next c
    Next b
Next a
Range("A1").Resize(UBound(x), v) = x

End Sub

 

[trader10518]

... or faster but somewhat less flexible is:

Sub test2()

Const u& = 20
Const v& = 4

Dim x(), a&, b&, c&, d&, k&
ReDim x(1 To Application.Combin(u, v), 1 To v)

For a = 1 To u
    For b = a + 1 To u
        For c = b + 1 To u
            For d = c + 1 To u
                k = k + 1
                x(k, 1) = a
                x(k, 2) = b
                x(k, 3) = c
                x(k, 4) = d
            Next d
        Next c
    Next b
Next a
Range("A1").Resize(UBound(x), v) = x

End Sub

Thanks, test2 works great. But if I want to take 5 out of 55? And the number of rows be more than 1,048,576?

 

[kalak]

Thanks, test2 works great. But if I want to take 5 out of 55? And the number of rows be more than 1,048,576?

Here's a suggested code. Took my computer about 15 secs to run.
Results are overflowed into additional columns as needed.

Sub test2_updated()

Const u& = 55
Const v& = 5
Const m& = 2 ^ 20
Dim x&(), a&, b&, c&, d&, e&, k&, r&, sp&
ReDim x(1 To m, 1 To v)
sp = v + 1
For a = 1 To u
    For b = a + 1 To u
        For c = b + 1 To u
            For d = c + 1 To u
                For e = d + 1 To u
                    k = k + 1
                    If k > m Then
                        Cells(sp * r + 1).Resize(m, v) = x
                        r = r + 1
                        k = 1
                        ReDim x(1 To m, 1 To v)
                    End If
                    x(k, 1) = a
                    x(k, 2) = b
                    x(k, 3) = c
                    x(k, 4) = d
                    x(k, 5) = e
                Next e
            Next d
        Next c
    Next b
Next a

Cells(sp * r + 1).Resize(k, v) = x

End Sub