VBA generate 5_50 combinations from (column A) list.

[motilulla]

Using Excel 2010
Hello,

I want a VBA that can generate 5_50 lottery combinations from list is in the column A from cell A6 to down. In this example there are 13 numbers which will generate total =COMBINAT(13;5)=1287 combination I want to list all them in Columns C:G

Excel Questions.xlsm
	A	B	C	D	E	F	G	H
1
2
3
4		Total Combi
5	Numbers	1.287	n1	n2	n3	n4	n5
6	1		1	2	4	6	12
7	2		1	2	4	6	15
8	4		1	2	4	6	16
9	6		1	2	4	6	26
10	12		1	2	4	6	28
11	15		1	2	4	6	31
12	16		1	2	4	6	37
13	26		1	2	4	6	41
14	28		1	2	4	6	43
15	31		1	2	4	12	15
16	37		1	2	4	12	16
17	41		1	2	4	12	26
18	43		1	2	4	12	28
19			1	2	4	12	31
20			1	2	4	12	37
21			1	2	4	12	41
22			1	2	4	12	43
23
24
25
26
27
Sheet5

Cell Formulas
Range	Formula
B5	B5	=COMBIN(13,5)

Regards,
Moti

 

[StephenCrump]

Try:

Sub Test()

    Dim lResults() As Long, lOutput() As Long, No() As Long, i As Long, j As Long
    Const N = 13
    Const k = 5
    
    ReDim No(1 To N)
    lResults = GetCombinations(N, k)
    ReDim lOutput(1 To UBound(lResults), 1 To UBound(lResults, 2))
    
    For i = 1 To N
        No(i) = Range("A" & i + 5).Value
    Next i
    For i = 1 To UBound(lResults)
        For j = 1 To UBound(lResults, 2)
            lOutput(i, j) = No(lResults(i, j))
        Next j
    Next i
        
    Range("C6").Resize(UBound(lResults), UBound(lResults, 2)).Value = lOutput

End Sub
Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

    Dim lOutput() As Long, lCombinations As Long
    Dim i As Long, j As Long, k As Long
    
    lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
    ReDim lOutput(1 To lCombinations, 1 To lNoChosen)
    
    For i = 1 To lNoChosen
        lOutput(1, i) = i
    Next i
    
    For i = 2 To lCombinations
        For j = 1 To lNoChosen
            lOutput(i, j) = lOutput(i - 1, j)
        Next j
        For j = lNoChosen To 1 Step -1
            lOutput(i, j) = lOutput(i, j) + 1
            If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
        Next j
        For k = j + 1 To lNoChosen
            lOutput(i, k) = lOutput(i, k - 1) + 1
        Next k
    Next i
    
    GetCombinations = lOutput
    
End Function

 

[motilulla]

Try:

Sub Test()

    Dim lResults() As Long, lOutput() As Long, No() As Long, i As Long, j As Long
    Const N = 13
    Const k = 5
 
    ReDim No(1 To N)
    lResults = GetCombinations(N, k)
    ReDim lOutput(1 To UBound(lResults), 1 To UBound(lResults, 2))
 
    For i = 1 To N
        No(i) = Range("A" & i + 5).Value
    Next i
    For i = 1 To UBound(lResults)
        For j = 1 To UBound(lResults, 2)
            lOutput(i, j) = No(lResults(i, j))
        Next j
    Next i
   
    Range("C6").Resize(UBound(lResults), UBound(lResults, 2)).Value = lOutput

End Sub
Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

    Dim lOutput() As Long, lCombinations As Long
    Dim i As Long, j As Long, k As Long
 
    lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
    ReDim lOutput(1 To lCombinations, 1 To lNoChosen)
 
    For i = 1 To lNoChosen
        lOutput(1, i) = i
    Next i
 
    For i = 2 To lCombinations
        For j = 1 To lNoChosen
            lOutput(i, j) = lOutput(i - 1, j)
        Next j
        For j = lNoChosen To 1 Step -1
            lOutput(i, j) = lOutput(i, j) + 1
            If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
        Next j
        For k = j + 1 To lNoChosen
            lOutput(i, k) = lOutput(i, k - 1) + 1
        Next k
    Next i
 
    GetCombinations = lOutput
 
End Function

StephenCrump, I am grateful, thank you so much, for giving me a perfect solution. I loved and it worked like magic.

Have a great time and Good Luck.

Kind regards,
Moti

 

[StephenCrump]

Thanks Moti, I'm glad it's working for you.