Combinations / Permutations VBA

[lrobbo314]

I know this has been covered, and believe me, I've looked around, but I haven't found a solution yet.

I am trying to figure out how to write a recursive function that will give every possible combination given a certain group size.

So, if the array is {1,2,3,4,5} and the group size is 3, I will get

1 2 3
1 2 4
1 2 5
1 3 4
1 3 5
1 4 5
2 3 4
2 3 5
2 4 5
3 4 5

And if I bump the group size to 4, I will get

1 2 3 4
1 2 3 5
1 2 4 5
1 3 4 5
2 3 4 5

I've tried to diagram out the sequence of events, as in table below, to try and figure out the code, but I've just been banging my head against the table.

So, if someone could help out and show me how this would work as a recursive VBA solution. Recursion has always made my head hurt.

	C	D	E	F	G	H	I
1	1	7	16	28	3	19	Results
2	1	7	16	28	3	19	1, 7
3	1	7	16	28	3	19	1, 16
4	1	7	16	28	3	19	1, 28
5	1	7	16	28	3	19	1, 3
6	1	7	16	28	3	19	1, 19
7	1	7	16	28	3	19	7, 16
8	1	7	16	28	3	19	7, 28
9	1	7	16	28	3	19	7, 3
10	1	7	16	28	3	19	7, 19
11	1	7	16	28	3	19	16, 28
12	1	7	16	28	3	19	16, 3
13	1	7	16	28	3	19	16, 19
14	1	7	16	28	3	19	28, 3
15	1	7	16	28	3	19	28, 19
16	1	7	16	28	3	19	3, 19
17	1	7	16	28	3	19	1, 7, 16
18	1	7	16	28	3	19	1, 7, 28
19	1	7	16	28	3	19	1, 7, 3
20	1	7	16	28	3	19	1, 7, 19
21	1	7	16	28	3	19	1, 16, 28
22	1	7	16	28	3	19	1, 16, 3
23	1	7	16	28	3	19	1, 16, 19
24	1	7	16	28	3	19	1, 28, 3
25	1	7	16	28	3	19	1, 28, 19
26	1	7	16	28	3	19	1, 3, 19

<caption>
</caption><colgroup><col style="width: 54px"><col width="133"><col width="149"><col width="133"><col width="133"><col width="133"><col width="133"><col width="133"></colgroup><tbody>
</tbody>

 

[Eric W]

You seem to really be interested in this question. I found a thread you started over 2 years ago with the same question.

https://www.mrexcel.com/forum/excel-questions/907809-recursive-vba-combinations.html

In any event, here's one way to do it:

Sub CallRecur()
Dim keys()


    Cells.ClearContents
    myitems = Array(1, 2, 3, 4, 5)
    groupsize = 3
    
    ReDim keys(0 To groupsize)
    keys(0) = 0
    
    Call Recur(myitems, UBound(myitems) + 1, groupsize, 0, keys)
    
    
End Sub


Sub Recur(ByVal MyArray, ByVal n, ByVal gs, ByVal d, ByVal keys)


    
    For i = keys(d) + 1 To n
        keys(d + 1) = i
        If d + 1 = gs Then
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
            For j = 1 To gs
                Cells(r, j) = MyArray(keys(j) - 1)
            Next j
        Else
            Call Recur(MyArray, n, gs, d + 1, keys)
        End If
    Next i


End Sub

Obviously, you can populate the array in many different ways, and you can print out the results in many different ways. Note that when defining the array as I did, the lowest index is 0, which is why there's some +1/-1 in the code. Since I'm just printing the results out on a sheet, this will error out when you hit the maximum number of rows per sheet. But I suspect you'll run out of stack space long before that.

Hope this gives you some ideas though.

 

[Eric W]

Same basic algorithm, but I used a couple of public variables to clean up the code, which should be easier to follow now. I also only write the results to the worksheet once, which should make it faster. Note the "" entry at the start of the array.

Public Results As Object
Public MyItems As Variant

Sub CallRecur()

    Set Results = CreateObject("Scripting.Dictionary")
    MyItems = Array("", "dog", "cat", "horse", "iguana", "parakeet")
    
    Call Recur(UBound(MyItems), 3, 0, 1, "")
    
    Cells.ClearContents
    Range("A1").Resize(Results.Count).Value = WorksheetFunction.Transpose(Results.keys)
    Range("A:A").TextToColumns OtherChar:="|"
    
End Sub

' n is the number of items, gs is group size, d is depth,
' curix is the current index, comb is the combination so far
Sub Recur(ByRef n, ByRef gs, ByVal d, ByVal curix, ByVal comb)
Dim i As Long, comb2 As String

    For i = curix To n
        comb2 = comb & MyItems(i) & "|"
        If d + 1 = gs Then
            Results.Add comb2, 1
        Else
            Call Recur(n, gs, d + 1, i + 1, comb2)
        End If
    Next i

End Sub

 

[lrobbo314]

Thank you so much! That old post you mentioned, I tried adapting some old code from that project, but it worked a little differently and I couldn't get it to work.

Stepping through your code, I realize that I was getting close to to the answer, but not quite.

I'll study this and try to figure out how it works.

Thanks again, this has been driving me crazy.