• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Combinations from Groups

D Moran

New Member
Hi, I have a difficult problem to solve.

There are 7 groups and each group has a number of subjects. A person can pick 3 subjects but can only pick one subject from any one of the groups. so, they have 7 group options but they really end up picking one subject from 3 groups (as they are only allowed do 3 subjects).

Out of the 7 groups, there are 35 group combinations = 7x6x5/3x2x1 = 210/6 = 35 group combinations.

I want to have a program that will list out all the combinations of subjects for each of the 35 group combinations. So, the following code works perfectly for the group combinations - Group 1, Group 2 and Group 3. Group 1 has 3 subjects, Group 2 has 5 subjects and Group 3 has 6 subjects. Therefore, the possible combinations of subjects from Group 1, Group 2 and Group 3 are 90 combinations -> 3x5x6x= 90 combinations. The following code works for this. See attached spreadsheet example.

The problem is that I want to do the same thing for the remaining 34 group combinations and I don't want to write a sub function for each of these combinations and just wondering if there is a cleaner way to do this. Sorry I am new to VBA. The total combinations from all of the 35 combinations of groups is 1298. Any help appreciated.

Code:
Sub List1stGroupCombinations()
Dim xDRg1, xDRg2, xDRg3 As Range
Dim xRg  As Range
Dim xStr As String
Dim xFN1, xFN2, xFN3 As Integer
Dim xSV1, xSV2, xSV3 As String
Set xDRg1 = Range("A2:A4")  'First Group
Set xDRg2 = Range("B2:B6")  'Second Group
Set xDRg3 = Range("C2:C7")  'Third  Group
xStr = "-"   'Separator
Set xRg = Range("I2")  'Output cell
For xFN1 = 1 To xDRg1.Count
    xSV1 = xDRg1.Item(xFN1).Text
    For xFN2 = 1 To xDRg2.Count
        xSV2 = xDRg2.Item(xFN2).Text
      For xFN3 = 1 To xDRg3.Count
        xSV3 = xDRg3.Item(xFN3).Text
        xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3
        Set xRg = xRg.Offset(1, 0)
       Next
    Next
Next
End Sub
 

Attachments

  • Combinations.xlsm
    19.9 KB · Views: 5
Last edited by a moderator:
Hi, according to your attachment a starter VBA demonstration (v2) :​
Code:
Sub Demo1()
    Dim C$(), G(), F%, R&, H&, J%, K&, S$, L%, M&
  ReDim C(1 To Rows.Count, 0), G(1 To [A1].End(xlToRight).Column)
        C(1, 0) = "Combinations :"
        Cells(UBound(G) + 2).CurrentRegion.Clear
    For F = 1 To UBound(G):  G(F) = Range(Cells(F), Cells(F).End(xlDown)):  Next
        R = 1
    For F = 1 To UBound(G) - 2
    For H = 2 To UBound(G(F))
    For J = F + 1 To UBound(G) - 1
    For K = 2 To UBound(G(J))
        S = G(F)(H, 1) & " - " & G(J)(K, 1) & " - "
    For L = J + 1 To UBound(G)
    For M = 2 To UBound(G(L))
        R = R + 1
        C(R, 0) = S & G(L)(M, 1)
    Next M, L, K, J, H, F
        Cells(UBound(G) + 2).Resize(R) = C
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Hi Marc,

Thanks so much, that works perfectly. Could you explain it a bit to me. What is UBound? What do all these variables do ->


Dim C$(), G(), F%, R&, H%, J%, K%, S$, L%, M%
 
I notice that i don't need to enter the range either which is great. Therefore, if i add or remove a subject from the group, i don't need to update it
 
As explained in VBA help - a must read ! - UBound is the array upper bound …​
All variables are necessary for the process, two arrays, six loop counters, a row index and a string.​
Each group values is stored within an array but no blank allowed in the column …​
 
There is one issue with this. Just say there is just one subject in a group, then it will error at line - For K = 1 To UBound(G(J))
Is there anyway to accommodate this. Its unlikely but it could happen that there would be just one subject in the group..
 
Post #2 VBA demonstration updated for such case ! (And thanks to follow the advice below the code …)
For VBA help you have the question box on VBE side at the top right side​
or just placing the text cursor on a statement then hitting the F1 key …​
 
Hi Marc,

Re your code above which is working great for me. How would i change it to now just pick 2 subjects from 7 groups, again they are only allowed pick 1 subject from 1 group but they have 7 groups to choose from. In total, the combinations have reduced to 21 combinations

Out of the 7 groups, there are 21 group combinations = 7x6/2x1 = 21 group combinations
 
My previous demonstration is based upon your initial code in order you can understand the necessary logic​
but this is not my usual way as with an efficient method it works whatever the subjects # to pick up, nothing to change !​
So once you understand the necessary logic for the first subject, the next level is to externalize the combination engine​
in a separate procedure to be called by the main procedure, this separate procedure calling itself until the subjects # is reached​
so this is a recursive procedure …​
According to your attachment with 1 298 combinations for 3 subjects among 7 groups so how many combinations for 2 subjects only ?
240 …
 
Hi Marc,

In total for 2 subjects out of 7 groups there is 240 combinations. see below

Group CombinationsNo. of Sub in 1st GroupNo. of Sub in 2nd GroupTotal Combinations per 2 Group Selection
1, 2
3​
5​
15​
1, 3
3​
6​
18​
1, 4
3​
2​
6​
1, 5
3​
3​
9​
1, 6
3​
2​
6​
1, 7
3​
3​
9​
2, 3
5​
6​
30​
2, 4
5​
2​
10​
2, 5
5​
3​
15​
2, 6
5​
2​
10​
2, 7
5​
3​
15​
3, 4
6​
2​
12​
3, 5
6​
3​
18​
3, 6
6​
2​
12​
3, 7
6​
3​
18​
4, 5
2​
3​
6​
4, 6
2​
2​
4​
4, 7
2​
3​
6​
5, 6
3​
2​
6​
5, 7
3​
3​
9​
6, 7
2​
3​
6​
Total Combinations
240​
 
Last edited by a moderator:
As I wrote in my previous post Spoiler …​
So did you catch the necessary to create the combination engine procedure, do you wanna give it a try ?​
 
According to your attachment a new demonstration with the same previous demonstration logic within a recursive procedure​
to paste only to the top of a module :​
Code:
Dim C$(), G, R&

Sub Combinate(ByVal M%, Optional ByVal K% = 1, Optional ByVal S$)
    Dim L&
    For K = K To UBound(G, 2) - M
    For L = 2 To UBound(G)
        If IsEmpty(G(L, K)) Then Exit For
        If M Then Combinate M - 1, K + 1, S & G(L, K) & " - " Else R = R + 1: C(R, 0) = S & G(L, K)
    Next L, K
End Sub

Sub Demo2()
        Const T = "Combinations"
    With [A1].CurrentRegion.Columns
        If .Count = 1 Then Beep: Exit Sub Else Cells(.Count + 2).CurrentRegion.Clear
    Do
        If V Then Beep
        V = Application.InputBox("  How many subjects ?  (2-" & .Count & ")", T, Type:=1)
        If V = False Then Exit Sub
    Loop Until V >= 2 And V <= .Count
        ReDim C(1 To Rows.Count, 0)
        C(1, 0) = T & " :"
        G = .Value
        R = 1
        Combinate V - 1
        Cells(.Count + 2).Resize(R) = C
    End With
        Erase C, G
End Sub
You should Like it !​
 
Back
Top