Generate list of combination from chosen factors

C

Corsa88

New Member
Joined
May 27, 2014
Messages
40
Hi guys

I am trying to generate a combination list (column D) from various factors.

For example:

ABCDE
1Factor_1Factor_2Factor_3Possible combinationsNo. of factors in combination
2a1b1c1a1-b1-c13
3a2b2c2a1-b1-c23
4a3b3c3...3
5a4b4a4-b5-c33
6b5a1-b12
..2
a4-b52
a1-c12
..2
a4-c32
b1-c12
..2
b5-c32

<tbody>
</tbody>

Now, I can generate the full set of combinations when all 3 factors are considered (i.e. No. of factors = 3). This is done using the code:

Code: 
Dim i As Integer
    For Each var1 In Range("A2:A6").SpecialCells(xlCellTypeConstants)
        For Each var2 In Range("B2:B6").SpecialCells(xlCellTypeConstants)
            For Each var3 In Range("C2:C6").SpecialCells(xlCellTypeConstants)
                
                Range("E2").Offset(i, 0).Value = var1
                Range("E2").Offset(i, 1).Value = var2
                Range("E2").Offset(i, 2).Value = var3
                
                    i = i + 1
            Next var3
        Next var2
    Next var1
End Sub

But, how can I modify this code to incorporate possibilities of excluding one factor, such that only combinations of 2 factors are also generated?

Thanks guys

Regards
Ben
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Possibly:

Code: 
Sub generateCombinations()
    Dim i As Integer
    Dim var1 As Range, var2 As Range, var3 As Range
    For Each var1 In Range("A2:A6").SpecialCells(xlCellTypeConstants)
        For Each var2 In Range("B2:B6").SpecialCells(xlCellTypeConstants)
            For Each var3 In Range("C2:C6").SpecialCells(xlCellTypeConstants)
                
                Range("E2").Offset(i, 0).Value = var1
                Range("E2").Offset(i, 1).Value = var2
                Range("E2").Offset(i, 2).Value = var3
                i = i + 1
            Next var3
            Range("E2").Offset(i, 0).Value = var1
            Range("E2").Offset(i, 1).Value = var2
            Range("E2").Offset(i, 2).Value = ""
            i = i + 1
        Next var2
        For Each var3 In Range("C2:C6").SpecialCells(xlCellTypeConstants)
            Range("E2").Offset(i, 0).Value = var1
            Range("E2").Offset(i, 1).Value = ""
            Range("E2").Offset(i, 2).Value = var3
            i = i + 1
        Next var3
    Next var1
    For Each var2 In Range("B2:B6").SpecialCells(xlCellTypeConstants)
        For Each var3 In Range("C2:C6").SpecialCells(xlCellTypeConstants)
            Range("E2").Offset(i, 0).Value = ""
            Range("E2").Offset(i, 1).Value = var2
            Range("E2").Offset(i, 2).Value = var3
            i = i + 1
        Next var3
    Next var2
End Sub
 
Upvote 0
Marcelbeug,

Thanks for the suggestion, and indeed, it works!

Is it possible to make the code more general instead of defining which variable to exclude manually? This is because I might have more than 3 variables. Say if I have 5 variables and if only 3 were chosen each time to generate the combinations, it might be cumbersome to definitely which variable to exclude manually.
 
Upvote 0
Please explain exactly and completely what you want. Otherwise we'll get an endless cycle of solutions and additional / changed requirements.
 
Upvote 0
Another problem I encountered was that I ran combinations for 6 variables. I used all 6 in the combinations and the macro ran into a overflow error, with results shown until row number 32769.

Previously, I remembered I could enter data till about 1 million rows. Any idea how could I remedy this?
 
Upvote 0
MarcelBeug said:
Please explain exactly and completely what you want. Otherwise we'll get an endless cycle of solutions and additional / changed requirements.
Click to expand...

My apologies for the ambiguous question. What I wanted was as in my original question, but perhaps to be able to include more factors, say 5 of them. The combination would be generated for all 5 factors, then 4 factors, then 3 and finally 2 factors. This could be done manually in your original formulation (i.e. leaving each factor out successively), but if we are choosing 3 factors out of 5 to generate the combination, it might be too cumbersome to define the 3 factors each time manually.
 
Upvote 0
Corsa88 said:
Another problem I encountered was that I ran combinations for 6 variables. I used all 6 in the combinations and the macro ran into a overflow error, with results shown until row number 32769.

Previously, I remembered I could enter data till about 1 million rows. Any idea how could I remedy this?
Click to expand...
Yes: define i as long instead of integer.
 
Upvote 0
It took a while as this is rather complicated but the following code works for max. 10 factors.
The code includes the use of a dictionary to prevent duplicate combinations and binary compare (e.g. If(J And 2 ^2) Then ...
There will always be 10 loops (also with less factors) so I could keep the code in 1 place: within the inner loop.

Instructions:
Copy your headings (starting in A1 to the right to max J1, which is column 10) to L1 and to the right.
Make sure K1 is empty.
If you run the code below, you'll get your combinations starting in L2.

Code: 
Sub generateCombinations()
    
    Dim c(1 To 10), cmb(1 To 10)
    Dim cntr1%, cntr2%, cntr3%, cntr4%, cntr5%, cntr6%, cntr7%, cntr8%, cntr9%, cntr10%
    Dim i1 As Long, i2 As Long, mc As Long
    Dim j%, nf%
    Dim DataArray, ResultArray, cdArray, Result
    Dim r As Double
    Dim cd As Object
    
    
    DataArray = Range("A1").CurrentRegion
    nf = UBound(DataArray, 2)
    
    If nf > 10 Then
        MsgBox "Max 10 factors allowed"
        Exit Sub
    End If
        
    If nf < 2 Then
        MsgBox "Min 2 factors required"
        Exit Sub
    End If
        
    mc = 2 ^ nf
    Set cd = CreateObject("scripting.dictionary")
        
    For i1 = 1 To 10
        If i1 > nf Then
            c(i1) = 0
        Else
            For i2 = 2 To UBound(DataArray, 1)
                If Not IsEmpty(DataArray(i2, i1)) Then c(i1) = c(i1) + 1
            Next i2
        End If
    Next i1
    
    For cntr1 = 1 To IIf(c(1) = 0, 1, c(1))
    For cntr2 = 1 To IIf(c(2) = 0, 1, c(2))
    For cntr3 = 1 To IIf(c(3) = 0, 1, c(3))
    For cntr4 = 1 To IIf(c(4) = 0, 1, c(4))
    For cntr5 = 1 To IIf(c(5) = 0, 1, c(5))
    For cntr6 = 1 To IIf(c(6) = 0, 1, c(6))
    For cntr7 = 1 To IIf(c(7) = 0, 1, c(7))
    For cntr8 = 1 To IIf(c(8) = 0, 1, c(8))
    For cntr9 = 1 To IIf(c(9) = 0, 1, c(9))
    For cntr10 = 1 To IIf(c(10) = 0, 1, c(10))
        For j = 3 To mc - 1
            r = WorksheetFunction.Log(j, 2)
            For i1 = 1 To 10
                cmb(i1) = ""
            Next i1
            If r <> Int(r) Then
                If j And 1 Then cmb(1) = DataArray(cntr1 + 1, 1)
                If j And 2 Then cmb(2) = DataArray(cntr2 + 1, 2)
                If nf >= 3 Then If j And 2 ^ 2 Then cmb(3) = DataArray(cntr3 + 1, 3)
                If nf >= 4 Then If j And 2 ^ 3 Then cmb(4) = DataArray(cntr4 + 1, 4)
                If nf >= 5 Then If j And 2 ^ 4 Then cmb(5) = DataArray(cntr5 + 1, 5)
                If nf >= 6 Then If j And 2 ^ 5 Then cmb(6) = DataArray(cntr6 + 1, 6)
                If nf >= 7 Then If j And 2 ^ 6 Then cmb(7) = DataArray(cntr7 + 1, 7)
                If nf >= 8 Then If j And 2 ^ 7 Then cmb(8) = DataArray(cntr8 + 1, 8)
                If nf >= 9 Then If j And 2 ^ 8 Then cmb(9) = DataArray(cntr9 + 1, 9)
                If nf >= 10 Then If j And 2 ^ 9 Then cmb(10) = DataArray(cntr10 + 1, 10)
                cd(cmb(1) & "|" & cmb(2) & "|" & cmb(3) & "|" & cmb(4) & "|" & cmb(5) & "|" & _
                    cmb(6) & "|" & cmb(7) & "|" & cmb(8) & "|" & cmb(9) & "|" & cmb(10)) = 1
            End If
        Next j
    Next cntr10
    Next cntr9
    Next cntr8
    Next cntr7
    Next cntr6
    Next cntr5
    Next cntr4
    Next cntr3
    Next cntr2
    Next cntr1
    
    cdArray = cd.keys
    
    ReDim ResultArray(0 To cd.Count - 1, 0 To 9)
    For i1 = 0 To cd.Count - 1
        Result = Split(cdArray(i1), "|")
        For i2 = 0 To 9
            ResultArray(i1, i2) = Result(i2)
        Next i2
    Next i1
    
    Range("L2").Resize(cd.Count, 10) = ResultArray
    
End Sub
 
Upvote 0
Marcel,

That code is very concise indeed. Works well for my purpose.

Appreciate your effort in this. Let me now learn the thinking behind this code and expand on it further. Thank you very much!
 
Upvote 0
Same code as post #8, now with a lot of explanatory notes added.

Code: 
Sub generateCombinations()
    
    'c will hold the counts of each factor; cmb will hold a single combination
    Dim c(1 To 10), cmb(1 To 10)
    
    '10 counters for 10 loops; it doesn't seem to work with an array; % is short for As Integer
    Dim cntr1%, cntr2%, cntr3%, cntr4%, cntr5%, cntr6%, cntr7%, cntr8%, cntr9%, cntr10%
    
    'i1 and i2 are counters; mc is the maximum number of combinations
    Dim i1 As Long, i2 As Long, mc As Long
    
    'j is a counter; nf is the number of factors in the sheet (min 2, max 10)
    Dim j%, nf%
    
    'DataArray is the input, ResultArray the output, cdArray is the contents from cd (see below),
    'Result is 1 element of cdArray after split in 10 elements
    Dim DataArray, ResultArray, cdArray, Result
    
    'r is used to check if a possible combination would have just 1 element, so not a valid combination
    Dim r As Double
    
    'cd is a dictionary. Dictionaries are very useful if you are looking for unique values.
    'Example:
    'After cd is initialized with CreateObject("scripting.dictionary") and subsequently, in this sequence:
    'cd(1) = "A" will create an entry with key 1 and value "A",
    'cd(2) = "B" will create an entry with key 2 and value "B"
    'cd(1) = "C" will OVERWRITE cd(1) with value "C"
    'In this procedure, cd entries are created with key values equal to a combination of 10 factors (separated by "|")
    'So if a cd entry is "created" again with a key that was alreay created, the entry will be overwritten.
    'So no need to bother about any duplicates: the dictionary will prevent duplicates.
    Dim cd As Object
    
    'Load DataArray with the input and determine the number of factors (nf)
    DataArray = Range("A1").CurrentRegion
    nf = UBound(DataArray, 2)
    
    'Check for too many factors
    If nf > 10 Then
        MsgBox "Max 10 factors allowed"
        Exit Sub
    End If
        
    'Check for not enough factors
    If nf < 2 Then
        MsgBox "Min 2 factors required"
        Exit Sub
    End If
        
    'Maximum number of combinations is 2 ^ 3.
    'E.g. with 3 factors, 2 ^ 3 = 8 "combinations" are possible: [I]empty[/I], A, B, C, AB, AC, BC, ABC
    mc = 2 ^ nf
    
    'Create the dictionary
    Set cd = CreateObject("scripting.dictionary")
        
    'Determine the number of elements for each factor
    For i1 = 1 To 10
        If i1 > nf Then
            c(i1) = 0
        Else
            For i2 = 2 To UBound(DataArray, 1)
                If Not IsEmpty(DataArray(i2, i1)) Then c(i1) = c(i1) + 1
            Next i2
        End If
    Next i1
    
    'Loops over the elements of each factor:
    For cntr1 = 1 To IIf(c(1) = 0, 1, c(1))
    For cntr2 = 1 To IIf(c(2) = 0, 1, c(2))
    For cntr3 = 1 To IIf(c(3) = 0, 1, c(3))
    For cntr4 = 1 To IIf(c(4) = 0, 1, c(4))
    For cntr5 = 1 To IIf(c(5) = 0, 1, c(5))
    For cntr6 = 1 To IIf(c(6) = 0, 1, c(6))
    For cntr7 = 1 To IIf(c(7) = 0, 1, c(7))
    For cntr8 = 1 To IIf(c(8) = 0, 1, c(8))
    For cntr9 = 1 To IIf(c(9) = 0, 1, c(9))
    For cntr10 = 1 To IIf(c(10) = 0, 1, c(10))
        
        'Now we have a combination of max 10 elements, we can start building combinations using a binary approach
        'we start with 3, because 1 and 2 binary are 1 and 10, so only 1 element and invalid combimnations
        '3 is 11 binary, so 2 elements
        'mc is a power of 2, representing 1 element, so the loop can stop at mc - 1
        For j = 3 To mc - 1
            'The following will result in a whole number if j is a power of 2: 4 --2, 8 --> 3, 16 --> 4
            'In such case it represents an invalid combination of only 1 element (4 = 100; 8 = 1000; 16 = 10000 etcetera)
            r = WorksheetFunction.Log(j, 2)
            'Initialize cmb to hold the current combination
            For i1 = 1 To 10
                cmb(i1) = ""
            Next i1
            'If valid combination, fill cmd with elements according to the binary representation of j
            'e.g. j = 3 (11) first 2 elements; j = 4 invalid; j = 5 (101) first and third element, etcetera
            'this is verified with If j And 2 ^ n, e.g. if j = 5 (101) then j And 4 (100) is true:
            'each bit of 5 (101) is compared with each bit of 4 (100), resulting in 1 as the first bit is 1 for both 4 and 5.
            If r <> Int(r) Then
                If j And 1 Then cmb(1) = DataArray(cntr1 + 1, 1)
                If j And 2 Then cmb(2) = DataArray(cntr2 + 1, 2)
                If nf >= 3 Then If j And 2 ^ 2 Then cmb(3) = DataArray(cntr3 + 1, 3)
                If nf >= 4 Then If j And 2 ^ 3 Then cmb(4) = DataArray(cntr4 + 1, 4)
                If nf >= 5 Then If j And 2 ^ 4 Then cmb(5) = DataArray(cntr5 + 1, 5)
                If nf >= 6 Then If j And 2 ^ 5 Then cmb(6) = DataArray(cntr6 + 1, 6)
                If nf >= 7 Then If j And 2 ^ 6 Then cmb(7) = DataArray(cntr7 + 1, 7)
                If nf >= 8 Then If j And 2 ^ 7 Then cmb(8) = DataArray(cntr8 + 1, 8)
                If nf >= 9 Then If j And 2 ^ 8 Then cmb(9) = DataArray(cntr9 + 1, 9)
                If nf >= 10 Then If j And 2 ^ 9 Then cmb(10) = DataArray(cntr10 + 1, 10)
                
                'Add dictionary entry with the key consisting of the combination, separated by |
                'If key already present, it won't be added. The "= 1" at the end is irrelevant.
                cd(cmb(1) & "|" & cmb(2) & "|" & cmb(3) & "|" & cmb(4) & "|" & cmb(5) & "|" & _
                    cmb(6) & "|" & cmb(7) & "|" & cmb(8) & "|" & cmb(9) & "|" & cmb(10)) = 1
            End If
        Next j
    Next cntr10
    Next cntr9
    Next cntr8
    Next cntr7
    Next cntr6
    Next cntr5
    Next cntr4
    Next cntr3
    Next cntr2
    Next cntr1
    
    'All combinations to cdArray
    cdArray = cd.keys
    
    'Format ResultArray with the required dimensions.
    'The dictionary and cdArray are zero based, so indices starting at 0
    ReDim ResultArray(0 To cd.Count - 1, 0 To 9)
    For i1 = 0 To cd.Count - 1
        'Split each combination in separate elements:
        Result = Split(cdArray(i1), "|")
        For i2 = 0 To 9
            ResultArray(i1, i2) = Result(i2)
        Next i2
    Next i1
    
    'Write the results to the worksheet
    Range("L2").Resize(cd.Count, 10) = ResultArray
    
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Function to repeatedly replace string one-at-a-time via a lookup table
Replies
4
Views
116
smallxyz
S
K
  • Question
Change code from inside sheet to userform directly
Replies
0
Views
148
KalilMe
K
B
  • Solved
Populating combobox from table based on the header selected in another combobox (some data on different sheets)
Replies
7
Views
228
BWL388
B
SaraWitch
  • Solved
Return values based on multiple cells
Replies
4
Views
227
etaf
etaf
S
  • Question
Need Help - Formula
2
Replies
16
Views
1K
ststern45
S

Forum statistics

Threads
1,214,590
Messages
6,120,423
Members
448,961
Latest member
nzskater

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top