vba to generate all combinations, no repeat, from a range?

[excelNewbie22]

hi,
i googled quite a lot, found a lot but not what i'm looking for,
i need a simple macro to generate an x numbers out of a range,
so i can edit it each time per my need,
with no repeation

for example
range will be a2:h2 (or more or less)
numbers of combinations 5 (or more or less)
if possible with hyphens seperate between i.e 1-2-3-4-5
all results in one column

can you please help?

New Microsoft Excel Worksheet.xlsx
	A	B	C	D	E	F	G	H	I	J
1									of 6	of 5
2	1	2	3	4	5	6	7	8	1-2-3-4-5-6	1-2-3-4-5
3									1-2-3-4-5-7	1-2-3-4-6
4									1-2-3-4-5-8	1-2-3-4-7
5									1-2-3-4-6-7	1-2-3-4-8
6									1-2-3-4-6-8	1-2-3-5-6
7									1-2-3-4-7-8	1-2-3-5-7
8									1-2-3-5-6-7	1-2-3-5-8
9									1-2-3-5-6-8	1-2-3-6-7
10									1-2-3-5-7-8	1-2-3-6-8
11									1-2-3-6-7-8	1-2-3-7-8
12									1-2-4-5-6-7	1-2-4-5-6
13									1-2-4-5-6-8	1-2-4-5-7
14									1-2-4-5-7-8	1-2-4-5-8
15									1-2-4-6-7-8	1-2-4-6-7
16									1-2-5-6-7-8	1-2-4-6-8
17									1-3-4-5-6-7	1-2-4-7-8
18									1-3-4-5-6-8	1-2-5-6-7
19									1-3-4-5-7-8	1-2-5-6-8
20									1-3-4-6-7-8	1-2-5-7-8
21									1-3-5-6-7-8	1-2-6-7-8
22									1-4-5-6-7-8	1-3-4-5-6
23									2-3-4-5-6-7	1-3-4-5-7
24									2-3-4-5-6-8	1-3-4-5-8
25									2-3-4-5-7-8	1-3-4-6-7
26									2-3-4-6-7-8	1-3-4-6-8
27									2-3-5-6-7-8	1-3-4-7-8
28									2-4-5-6-7-8	1-3-5-6-7
29									3-4-5-6-7-8	1-3-5-6-8
30										1-3-5-7-8
31										1-3-6-7-8
32										1-4-5-6-7
33										1-4-5-6-8
34										1-4-5-7-8
35										1-4-6-7-8
36										1-5-6-7-8
37										2-3-4-5-6
38										2-3-4-5-7
39										2-3-4-5-8
40										2-3-4-6-7
41										2-3-4-6-8
42										2-3-4-7-8
43										2-3-5-6-7
44										2-3-5-6-8
45										2-3-5-7-8
46										2-3-6-7-8
47										2-4-5-6-7
48										2-4-5-6-8
49										2-4-5-7-8
50										2-4-6-7-8
51										2-5-6-7-8
52										3-4-5-6-7
53										3-4-5-6-8
54										3-4-5-7-8
55										3-4-6-7-8
56										3-5-6-7-8
57										4-5-6-7-8
test

 

[johnnyL]

Example:
Pool of 32, #s drawn 6
Combin(32,6) = 906,192 combinations
Time to complete = 4.810791015625 seconds.

 

[cmowla]

the amount: 9 to 35 - which will be determine by the range

If you really want to have up to 35 numbers, 35 taking 17 at a time is over 4 billion combinations. That's too much for Excel (considering that's just one combination set of the whole).

I recently wrote (quite rudimentary, nothing to share here) code to do combinations, and I used it to compute combinations for numbers that were 4 characters each (for example, 1.43 = 4 characters), just for 29 of these numbers, taking from 10 at a time to 19 at a time, and that was 36 gigabytes of data! (That was roughly 2^29 combinations. 2^35 combinations is 64 times as much data!) You cannot use Excel to house that data. It could contain it (in theory), but you wouldn't be able to open the Excel file.

I couldn't even open .txt files with Notepad++ unless they were less than 500mb each. So what I did was implement a counter into my combinations program so that after a certain (specified) number of generated combinations, it would create a new .txt file and start filling that one up. Therefore, the same should be done here, if you are really serious about finding the combinations of that many numbers. You (or someone you ask) can write a script to bring the particular .txt file you wish to view in Excel into Excel, however. Not sure what this is for, but you can't just put all of these combinations into a table and search it, for example. You have to know (by the look of the first combination in the file) which .txt file contains the combination set that you desire.

. . . and you may need to buy a few extra external hard drives that can hold a lot of data!

@johnnyL ,
Since you put in all of this time to write this, if you perhaps are interested to see how I had Excel create .txt files of equal size to house all of the generate combinations, let me know.

 

[excelNewbie22]

hi johnny,
just checked in,

What does that mean? You already have a file that works for this thread?

no, i meant the file where i would like to apply the vba

your macro is great!

but, can you please make a few adjustments?
since where i would run the macro, would be a file with lot's of data,
i would rather if i can write the range inside the macro instead of let it read from a row number
something like this? NumbersPoolRow = h1:v1 maybe?
same for the destination

  ResultSkipColumnAmount = 2

maybe = w2 ?
for

DrawAmount = "6"

already got it,
any maybe move

Total # of combinations

to the top of ResultSkipColumnAmount as in w1 ? although i can do without it

 

[johnnyL]

How about:

Option Explicit
'
' Inspired by some previous code from pgc01 https://www.mrexcel.com/board/threads/combination-help.277924/post-1379220
'
Sub AllCombinationsV2()
'
    Dim StartTime                   As Double
    StartTime = Timer                                                                                               ' Start the stop watch
'
    Dim ArrayRow                    As Long
    Dim DrawAmount                  As Long, TotalCombinations      As Long
    Dim OutputRow                   As Long
    Dim PoolSize                    As Long
    Dim NumbersPoolRange            As Range
    Dim OutputColumn                As String
    Dim OutputHeader                As String
    Dim NumbersDrawnArray           As Variant, NumbersPoolArray    As Variant, OutputArray     As Variant
'
    Set NumbersPoolRange = Range("H1:V1")                                                                           ' <--- Set this to the range of the pool #s to use
    DrawAmount = Range("B2").Value                                                                                  ' <--- set the amount of #s to pick in this cell
    OutputColumn = "W"                                                                                              ' <--- Set this to the column letter that you want to display results to
    OutputRow = 2                                                                                                   ' <--- Set this to the row # to start displaying the combinations
    PoolSize = NumbersPoolRange.Columns.Count                                                                       ' Get the amount of numbers in the pool
    OutputHeader = DrawAmount & " of " & PoolSize                                                                   ' <--- Set this to the header for the output column
'
    Application.ScreenUpdating = False                                                                              ' Turn screen updationg off
'
    TotalCombinations = Application.WorksheetFunction.Combin(NumbersPoolRange.Count, DrawAmount)                    ' Get total # of combinations that will be produced
'
    NumbersPoolArray = NumbersPoolRange                                                                             ' Load pool of numbers to use into 2D 1 based NumbersPoolArray
'
    Range("A3").Value = "Total # of combinations"                                                                   ' Display header of 'Total # of combinations'
    Range("B3").Value = TotalCombinations                                                                           ' Display # of combinations that will be generated
'
    ReDim NumbersDrawnArray(1 To DrawAmount)                                                                        ' Establish size of 1D one based NumbersDrawnArray
    ReDim OutputArray(1 To TotalCombinations, 1 To DrawAmount)                                                      ' Establish size of 2D one based OutputArray
'
    Call GetAllCombinations(NumbersPoolArray, DrawAmount, NumbersDrawnArray, ArrayRow, OutputArray, 1, 1)           ' Calculate the Combinations
'
    Range(OutputColumn & OutputRow - 1).Value = OutputHeader                                                        ' Display output header
    Range(OutputColumn & OutputRow).Resize(TotalCombinations, 1).Value = OutputArray                                ' Display results to sheet
'
    ActiveSheet.UsedRange.EntireColumn.AutoFit                                                                      ' Autofit all column widths on the sheett
'
    Application.ScreenUpdating = True                                                                               ' Turn screen updationg back on
'
    Debug.Print TotalCombinations & " combinations completed in " & Timer - StartTime & " seconds."                 ' Display the completion time in the 'Immediate' window ... CTRL+G in the VBE window
    MsgBox TotalCombinations & " combinations completed in " & Timer - StartTime & " seconds."                      ' Display the combination count & time to complete to the user
End Sub


Sub GetAllCombinations(ByVal NumbersPoolArray As Variant, ByVal DrawAmount As Long, ByVal NumbersDrawnArray As Variant, _
        ByRef ArrayRow As Long, ByRef OutputArray As Variant, ByVal NumbersPoolColumn As Long, ByVal DrawNumber As Long)
'
    Dim ArrayColumn         As Long
'
    For NumbersPoolColumn = NumbersPoolColumn To UBound(NumbersPoolArray, 2)                                        ' Loop through the NumbersPoolArray columns
        NumbersDrawnArray(DrawNumber) = NumbersPoolArray(1, NumbersPoolColumn)                                      '   Save NumbersPoolArray(1, NumbersPoolColumn) value to NumbersDrawnArray(DrawNumber)
'
        If DrawNumber = DrawAmount Then                                                                             '   If last DrawNumber of DrawAmount has been reached then ...
            ArrayRow = ArrayRow + 1                                                                                 '       Increment ArrayRow
'
            For ArrayColumn = 1 To DrawAmount                                                                       '       Loop through NumbersDrawnArray columns
                OutputArray(ArrayRow, 1) = OutputArray(ArrayRow, 1) & NumbersDrawnArray(ArrayColumn) & "-"          '           Save NumbersDrawnArray column value & delimiter to OutputArray
            Next                                                                                                    '       Loop back
'
            OutputArray(ArrayRow, 1) = Left$(OutputArray(ArrayRow, 1), Len(OutputArray(ArrayRow, 1)) - 1)           '       Remove the last delimiter '-' from the OutputArray string
        Else                                                                                                        '   Else ...
            Call GetAllCombinations(NumbersPoolArray, DrawAmount, NumbersDrawnArray, ArrayRow, _
                    OutputArray, NumbersPoolColumn + 1, DrawNumber + 1)                                             '       Recursive loop to get next value of NumbersDrawnArray
        End If
    Next                                                                                                            ' Loop back
End Sub

 

[excelNewbie22]

much appreciated johnny!
thank you very much !!

 

[johnnyL]

Glad to help.

 

[JEC]

How about this one

Dim ar, a, sq, x As Long

Sub jec()
 ar = [transpose(transpose(A2:H2))]
 a = Application.InputBox("Combin of...", , , , , , , 1)
 ReDim sq(Application.Combin(UBound(ar), a), 0)
 x = 0
 
 Application.ScreenUpdating = False
 
 Gen_comb "", -1, UBound(ar) - a
     
 With Cells(2, 13)
   .CurrentRegion.ClearContents
   .Resize(x) = sq
 End With
End Sub

Sub Gen_comb(xStr As String, y As Long, n As Long)
 Dim sp, j As Long
 For j = y + 1 To n
    sp = xStr & ar(j + 1)
    If Len(sp) = a Then
      sq(x, 0) = Join(Split(Trim(Replace(StrConv(sp, 64), Chr(0), " "))), "-")
      x = x + 1
    Else
      Gen_comb xStr & ar(j + 1), j, n + 1
   End If
 Next
End Sub

 

[cmowla]

How about this one

Well, when I ran this first test on it, it split up a 2 digit number into single digits: (I typed in 6 into the input bar.)

Blank.xlsb
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2	44	2	33	1	5	6	7	8					4-4-2-3-3-1
3													4-4-2-3-3-5
4													4-4-2-3-3-6
5													4-4-2-1-5-6
6													4-4-2-1-5-7
7													4-4-2-1-6-7
8													4-4-2-5-6-7
9													4-4-3-3-1-5
10													4-4-3-3-1-6
11													4-4-3-3-5-6
12													4-4-1-5-6-7
13													2-3-3-1-5-6
14													2-3-3-1-5-7
15													2-3-3-1-6-7
16													2-3-3-5-6-7
17													2-1-5-6-7-8
18													3-3-1-5-6-7
Sheet11

 

[johnnyL]

Well, when I ran this first test on it, it split up a 2 digit number into single digits: (I typed in 6 into the input bar.)

I confirm that.

 

[JEC]

Correct, this was for single numbers. How about:

Dim ar, a, sq, x As Long

Sub jec()
 ar = [transpose(transpose(A2:H2))]
 a = Application.InputBox("Combin of...", , , , , , , 1)
 ReDim sq(Application.Combin(UBound(ar), a), 0)
 x = 0
 
 Application.ScreenUpdating = False
 
 Gen_comb "", -1, UBound(ar) - a
     
 With Cells(2, 13)
   .CurrentRegion.ClearContents
   .Resize(x) = sq
 End With
End Sub

Sub Gen_comb(xStr As String, y As Long, n As Long)
 Dim sp, j As Long
 For j = y + 1 To n
    sp = xStr & ar(j + 1)
    If UBound(Split(sp, "-")) = a - 1 Then
      sq(x, 0) = sp
      x = x + 1
    Else
      Gen_comb xStr & ar(j + 1) & "-", j, n + 1
   End If
 Next
End Sub