VBA to Make Combinations with Dynamic Data

thenapolitan · Jul 12, 2015

Hey Guys,

I've been racking my brain and can't seem to figure out the coding logic for what I'm doing. Basically, what I want to do is get all the combinations for a subset of parts to eventually come up with a gap/tolerance stack equation (not automated, yet).

I ask the user how many unique parts exist (in the example below, the user entered 3, but could be any number). I then ask how many duplicates of each (in this case 3 of part 1, 3 of part 2, and 2 of part 3, but again, these numbers could vary). It populates TABLE 1 below.

I populate a 2D array like this, but I'm not sure this is really how it should be done.

part	# of parts	dims
1	3	3
2	3	2
3	2	1

Now, I want to make a matrix to show all combinations of those parts. There should be 18 combinations (3*3*2). And I want the matrix to look like TABLE 2.

I just can't wrap my head around how to get this to work for any number of unique parts, with any number of duplicates and any number of dimensions.

Any ideas?

Thanks,

Chris

TABLE 1

A	B	C	D	E	F	G	H	I
Part:	1		Number of Parts:	3			Number of Dimensions:	3
	Dim 1	Dim 2	Dim 3
Part 1 of 1:	111	112	113
Part 2 of 1:	121	122	123
Part 3 of 1:	131	132	133

Part:	2		Number of Parts:	3			Number of Dimensions:	2
	Dim 1	Dim 2
Part 1 of 2:	211	212
Part 2 of 2:	221	222
Part 3 of 2:	231	232

Part:	3		Number of Parts:	2			Number of Dimensions:	1
	Dim 1
Part 1 of 3:	311
Part 2 of 3:	321

TABLE 2

Combo #	Part 1	Part 2	Part 3	Part 1 Dim 1	Part 1 Dim 2	Part 1 Dim 3	Part 2 Dim 1	Part 2 Dim 2	Part 3 Dim 1	Gap Formula
1	1	1	1	111	112	113	211	212	311
2	1	1	2	111	112	113	211	212	321
3	1	2	1	111	112	113	221	222	311
4	1	2	2	111	112	113	221	222	321
5	1	3	1	111	112	113	231	232	311
6	1	3	2	111	112	113	231	232	321
7	2	1	1	121	122	123	211	212	311
8	2	1	2	121	122	123	211	212	321
9	2	2	1	121	122	123	221	222	311
10	2	2	2	121	122	123	221	222	321
11	2	3	1	121	122	123	231	232	311
12	2	3	2	121	122	123	231	232	321
13	3	1	1	131	132	133	211	212	311
14	3	1	2	131	132	133	211	212	321
15	3	2	1	131	132	133	221	222	311
16	3	2	2	131	132	133	221	222	321
17	3	3	1	131	132	133	231	232	311
18	3	3	2	131	132	133	231	232	321

thenapolitan · Jul 13, 2015

shg said:
Did you read this part of the instructions?

Ah, yes, I see that now. Was hoping to get this done programmatically instead of through functions.

shg · Jul 13, 2015

Did you see the second tab where it gets done programmatically instead of through functions?

thenapolitan · Jul 13, 2015

shg said:
Did you see the second tab where it gets done programmatically instead of through functions?

Yes, but it does not give the option to programmatically use more or less than the specified columns.

I think I am going to programmatically populated the FORMULAS side and see if I can make it work that way using the combination. Will definitely post results.

Ideally, I'd like to come up with a recursive function that will do all of this for an infinite number of cases. Here is my case statement right now (only works up to case 10). For each case, all it is is the addition of another For-to loop and an extra array. Kind of hefty without recursion. Just can't wrap my head around recursion though....

Code:

Sub CartesianProduct(MatrixSheet As Worksheet)
    Dim startrange As range


    Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, g As Integer, h As Integer, i As Integer, j As Integer
    Dim x As Integer, z As Integer


    x = Worksheets("Sheet1").range("D2")
    z = 0


    Select Case x
        Case 1
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            array1 = [range1]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                z = z + 1
                startrange.range("C2").Offset(z, 0).Value = array1(a, 1)
            Next a
        Case 2
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            
            array1 = [range1]
            array2 = [range2]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    z = z + 1
                    startrange.Offset(z, 0).Value = array1(a, 1)
                    startrange.Offset(z, 1).Value = array1(b, 1)
                Next b
            Next a
        Case 3
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            
            array1 = [range1]
            array2 = [range2]
            array3 = [range3]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        z = z + 1
                        startrange.Offset(z, 0).Value = array1(a, 1)
                        startrange.Offset(z, 1).Value = array1(b, 1)
                        startrange.Offset(z, 2).Value = array1(c, 1)
                    Next c
                Next b
            Next a
        Case 4
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            
            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            z = z + 1
                            startrange.Offset(z, 0).Value = array1(a, 1)
                            startrange.Offset(z, 1).Value = array1(b, 1)
                            startrange.Offset(z, 2).Value = array1(c, 1)
                            startrange.Offset(z, 3).Value = array1(d, 1)
                        Next d
                    Next c
                Next b
            Next a
        Case 5
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                z = z + 1
                                startrange.Offset(z, 0).Value = array1(a, 1)
                                startrange.Offset(z, 1).Value = array1(b, 1)
                                startrange.Offset(z, 2).Value = array1(c, 1)
                                startrange.Offset(z, 3).Value = array1(d, 1)
                                startrange.Offset(z, 3).Value = array1(e, 1)
                            Next e
                        Next d
                    Next c
                Next b
            Next a
        Case 6
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)
            range6 = Application.InputBox(Prompt:="Please Select Range 6", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]
            array6 = [range6]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                For f = 1 To UBound(array4)
                                    z = z + 1
                                    startrange.Offset(z, 0).Value = array1(a, 1)
                                    startrange.Offset(z, 1).Value = array1(b, 1)
                                    startrange.Offset(z, 2).Value = array1(c, 1)
                                    startrange.Offset(z, 3).Value = array1(d, 1)
                                    startrange.Offset(z, 3).Value = array1(e, 1)
                                    startrange.Offset(z, 3).Value = array1(f, 1)
                                Next f
                            Next e
                        Next d
                    Next c
                Next b
            Next a
        Case 7
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)
            range6 = Application.InputBox(Prompt:="Please Select Range 6", Type:=8)
            range7 = Application.InputBox(Prompt:="Please Select Range 7", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]
            array6 = [range6]
            array7 = [range7]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                For f = 1 To UBound(array4)
                                    For g = 1 To UBound(array4)
                                        z = z + 1
                                        startrange.Offset(z, 0).Value = array1(a, 1)
                                        startrange.Offset(z, 1).Value = array1(b, 1)
                                        startrange.Offset(z, 2).Value = array1(c, 1)
                                        startrange.Offset(z, 3).Value = array1(d, 1)
                                        startrange.Offset(z, 3).Value = array1(e, 1)
                                        startrange.Offset(z, 3).Value = array1(f, 1)
                                        startrange.Offset(z, 3).Value = array1(g, 1)
                                    Next g
                                Next f
                            Next e
                        Next d
                    Next c
                Next b
            Next a
        Case 8
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)
            range6 = Application.InputBox(Prompt:="Please Select Range 6", Type:=8)
            range7 = Application.InputBox(Prompt:="Please Select Range 7", Type:=8)
            range8 = Application.InputBox(Prompt:="Please Select Range 8", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]
            array6 = [range6]
            array7 = [range7]
            array8 = [range8]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                For f = 1 To UBound(array4)
                                    For g = 1 To UBound(array4)
                                        For h = 1 To UBound(array4)
                                            z = z + 1
                                            startrange.Offset(z, 0).Value = array1(a, 1)
                                            startrange.Offset(z, 1).Value = array1(b, 1)
                                            startrange.Offset(z, 2).Value = array1(c, 1)
                                            startrange.Offset(z, 3).Value = array1(d, 1)
                                            startrange.Offset(z, 3).Value = array1(e, 1)
                                            startrange.Offset(z, 3).Value = array1(f, 1)
                                            startrange.Offset(z, 3).Value = array1(g, 1)
                                            startrange.Offset(z, 3).Value = array1(h, 1)
                                        Next h
                                    Next g
                                Next f
                            Next e
                        Next d
                    Next c
                Next b
            Next a
        Case 9
                        range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)
            range6 = Application.InputBox(Prompt:="Please Select Range 6", Type:=8)
            range7 = Application.InputBox(Prompt:="Please Select Range 7", Type:=8)
            range8 = Application.InputBox(Prompt:="Please Select Range 8", Type:=8)
            range9 = Application.InputBox(Prompt:="Please Select Range 9", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]
            array6 = [range6]
            array7 = [range7]
            array8 = [range8]
            array9 = [range9]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                For f = 1 To UBound(array4)
                                    For g = 1 To UBound(array4)
                                        For h = 1 To UBound(array4)
                                            For i = 1 To UBound(array4)
                                                z = z + 1
                                                startrange.Offset(z, 0).Value = array1(a, 1)
                                                startrange.Offset(z, 1).Value = array1(b, 1)
                                                startrange.Offset(z, 2).Value = array1(c, 1)
                                                startrange.Offset(z, 3).Value = array1(d, 1)
                                                startrange.Offset(z, 3).Value = array1(e, 1)
                                                startrange.Offset(z, 3).Value = array1(f, 1)
                                                startrange.Offset(z, 3).Value = array1(g, 1)
                                                startrange.Offset(z, 3).Value = array1(h, 1)
                                                startrange.Offset(z, 3).Value = array1(i, 1)
                                            Next i
                                        Next h
                                    Next g
                                Next f
                            Next e
                        Next d
                    Next c
                Next b
            Next a


        Case 10
            range1 = Application.InputBox(Prompt:="Please Select Range 1", Type:=8)
            range2 = Application.InputBox(Prompt:="Please Select Range 2", Type:=8)
            range3 = Application.InputBox(Prompt:="Please Select Range 3", Type:=8)
            range4 = Application.InputBox(Prompt:="Please Select Range 4", Type:=8)
            range5 = Application.InputBox(Prompt:="Please Select Range 5", Type:=8)
            range6 = Application.InputBox(Prompt:="Please Select Range 6", Type:=8)
            range7 = Application.InputBox(Prompt:="Please Select Range 7", Type:=8)
            range8 = Application.InputBox(Prompt:="Please Select Range 8", Type:=8)
            range9 = Application.InputBox(Prompt:="Please Select Range 9", Type:=8)
            range10 = Application.InputBox(Prompt:="Please Select Range 10", Type:=8)


            array1 = [range1]
            array2 = [range2]
            array3 = [range3]
            array4 = [range4]
            array5 = [range5]
            array6 = [range6]
            array7 = [range7]
            array8 = [range8]
            array9 = [range9]
            array10 = [range10]


            Set startrange = MatrixSheet.range("C1")
            For a = 1 To UBound(array1)
                For b = 1 To UBound(array2)
                    For c = 1 To UBound(array3)
                        For d = 1 To UBound(array4)
                            For e = 1 To UBound(array4)
                                For f = 1 To UBound(array4)
                                    For g = 1 To UBound(array4)
                                        For h = 1 To UBound(array4)
                                            For i = 1 To UBound(array4)
                                                For j = 1 To UBound(array4)
                                                    z = z + 1
                                                    startrange.Offset(z, 0).Value = array1(a, 1)
                                                    startrange.Offset(z, 1).Value = array1(b, 1)
                                                    startrange.Offset(z, 2).Value = array1(c, 1)
                                                    startrange.Offset(z, 3).Value = array1(d, 1)
                                                    startrange.Offset(z, 3).Value = array1(e, 1)
                                                    startrange.Offset(z, 3).Value = array1(f, 1)
                                                    startrange.Offset(z, 3).Value = array1(g, 1)
                                                    startrange.Offset(z, 3).Value = array1(h, 1)
                                                    startrange.Offset(z, 3).Value = array1(i, 1)
                                                    startrange.Offset(z, 3).Value = array1(j, 1)
                                                Next j
                                            Next i
                                        Next h
                                    Next g
                                Next f
                            Next e
                        Next d
                    Next c
                Next b
            Next a
    End Select
End Sub

shg · Jul 13, 2015

Really?

Did you try just adding additional columns of input to the right and pushing the button?

Row\Col	B	C	D	E	F
4	Dumplings	Kung Pao Shrimp	Fried rice	Fortune Cookie	Alan
5	Egg roll	Orange Beef	Steamed rice	Ice Cream	Barb
6	Wonton soup	Pork Lo Mein	Rice noodles		Cain
7		Roast Duck
8		Szechuan Chicken
9
10	Dumplings	Kung Pao Shrimp	Fried rice	Fortune Cookie	Alan
11	Dumplings	Kung Pao Shrimp	Fried rice	Fortune Cookie	Barb
12	Dumplings	Kung Pao Shrimp	Fried rice	Fortune Cookie	Cain
13	Dumplings	Kung Pao Shrimp	Fried rice	Ice Cream	Alan
14	Dumplings	Kung Pao Shrimp	Fried rice	Ice Cream	Barb
15	Dumplings	Kung Pao Shrimp	Fried rice	Ice Cream	Cain
16	Dumplings	Kung Pao Shrimp	Steamed rice	Fortune Cookie	Alan
17	Dumplings	Kung Pao Shrimp	Steamed rice	Fortune Cookie	Barb
18	Dumplings	Kung Pao Shrimp	Steamed rice	Fortune Cookie	Cain

thenapolitan · Jul 14, 2015

Oh my gosh....too many distractions yesterday. I really thought I tried that. Thanks so much shg!

shg · Jul 14, 2015

You're welcome.

VBA to Make Combinations with Dynamic Data

thenapolitan

Board Regular

thenapolitan

Board Regular

Excel Facts

shg

MrExcel MVP

thenapolitan

Board Regular

shg

MrExcel MVP

thenapolitan

Board Regular

shg

MrExcel MVP

Similar threads

Forum statistics

Share this page

VBA to Make Combinations with Dynamic Data

thenapolitan

Board Regular

thenapolitan

Board Regular

Excel Facts

shg

MrExcel MVP

thenapolitan

Board Regular

shg

MrExcel MVP

thenapolitan

Board Regular

shg

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock