VBA can create all possible sets of Min and Max Sums

[motilulla]

Hello,

I have got 42 random numbers in 3 rows and in 14 columns in cells D6:Q8 my task is to pick 1 number from each column and use 14 columns (make set of 14 numbers) with Min and Max of sums

In the example given below you can see the min sum could be made = 126 and the max sum = 484

I need macro which and list all possible sets can be formed between Min & Max sum (in this given example case all between 126 & 484)

Here is the sample data

Book1
	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1
2
3
4
5		C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14
6	Row 1	5	45	25	44	15	5	71	3	0	13	0	8	28	15
7	Row 2	36	29	13	84	1	45	46	2	31	2	9	2	27	32
8	Row 3	8	5	6	86	6	14	44	24	17	17	12	17	10	0
9
10
11	Min Sum	5	5	6	44	1	5	44	2	0	2	0	2	10	0	126
12
13	Max Sum	36	45	25	86	15	45	71	24	31	17	12	17	28	32	484
14
15
16
Sheet1

Cell Formulas
Range	Formula
R11	=SUM(D11:Q11)
R13	=SUM(D13:Q13)

Thank you all
Excel 2000
Regards,
Moti

 

[B___P]

Hi Moti,
here the code to list combinations matching a specific sum. It is based on post #10 layout.

Sub MOTIshowCOMBS()
    Dim myarr(1 To 14) As Variant
    Dim mysum As Long
    Dim mynumbers As Variant
    Dim T As Single
    
    T = Timer
    mysum = Range("C5").Value
    mynumbers = Range("D6:Q8").Value
    Range("x6", Cells(ActiveSheet.Cells(Rows.Count, 24).End(xlUp).Row + 1, 38)).ClearContents
    For x1 = 1 To 3: For x2 = 1 To 3: For x3 = 1 To 3: For x4 = 1 To 3
        For x5 = 1 To 3: For x6 = 1 To 3: For x7 = 1 To 3: For x8 = 1 To 3
            For x9 = 1 To 3: For x10 = 1 To 3:  For x11 = 1 To 3: For x12 = 1 To 3
                For x13 = 1 To 3:  For x14 = 1 To 3
                    myarr(1) = mynumbers(x1, 1)
                    myarr(2) = mynumbers(x2, 2)
                    myarr(3) = mynumbers(x3, 3)
                    myarr(4) = mynumbers(x4, 4)
                    myarr(5) = mynumbers(x5, 5)
                    myarr(6) = mynumbers(x6, 6)
                    myarr(7) = mynumbers(x7, 7)
                    myarr(8) = mynumbers(x8, 8)
                    myarr(9) = mynumbers(x9, 9)
                    myarr(10) = mynumbers(x10, 10)
                    myarr(11) = mynumbers(x11, 11)
                    myarr(12) = mynumbers(x12, 12)
                    myarr(13) = mynumbers(x13, 13)
                    myarr(14) = mynumbers(x14, 14)
                    tot = myarr(1) + myarr(2) + myarr(3) + myarr(4) + myarr(5) + myarr(6) + myarr(7) + myarr(8) + myarr(9) + myarr(10) + myarr(11) + myarr(12) + myarr(13) + myarr(14)
                    If tot = mysum Then
                        lastrow = ActiveSheet.Cells(Rows.Count, 24).End(xlUp).Row
                        ActiveSheet.Range(Cells(lastrow + 1, 24), Cells(lastrow + 1, 37)).Value = myarr
                        ActiveSheet.Cells(lastrow + 1, 38).Value = tot
                    End If
                    DoEvents
                Next x14: Next x13
            Next x12:  Next x11: Next x10: Next x9
        Next x8: Next x7: Next x6: Next x5
    Next x4: Next x3: Next x2: Next x1
    MsgBox (Timer - T)
End Sub

None of sums lists more combinations than rows in excel 2000 worksheet.
Hope this helps

Have a nice rest of the day

 

[motilulla]

Hi Moti,
here the code to list combinations matching a specific sum. It is based on post #10 layout.

Sub MOTIshowCOMBS()
    Dim myarr(1 To 14) As Variant
    Dim mysum As Long
    Dim mynumbers As Variant
    Dim T As Single
    
    T = Timer
    mysum = Range("C5").Value
    mynumbers = Range("D6:Q8").Value
    Range("x6", Cells(ActiveSheet.Cells(Rows.Count, 24).End(xlUp).Row + 1, 38)).ClearContents
    For x1 = 1 To 3: For x2 = 1 To 3: For x3 = 1 To 3: For x4 = 1 To 3
        For x5 = 1 To 3: For x6 = 1 To 3: For x7 = 1 To 3: For x8 = 1 To 3
            For x9 = 1 To 3: For x10 = 1 To 3:  For x11 = 1 To 3: For x12 = 1 To 3
                For x13 = 1 To 3:  For x14 = 1 To 3
                    myarr(1) = mynumbers(x1, 1)
                    myarr(2) = mynumbers(x2, 2)
                    myarr(3) = mynumbers(x3, 3)
                    myarr(4) = mynumbers(x4, 4)
                    myarr(5) = mynumbers(x5, 5)
                    myarr(6) = mynumbers(x6, 6)
                    myarr(7) = mynumbers(x7, 7)
                    myarr(8) = mynumbers(x8, 8)
                    myarr(9) = mynumbers(x9, 9)
                    myarr(10) = mynumbers(x10, 10)
                    myarr(11) = mynumbers(x11, 11)
                    myarr(12) = mynumbers(x12, 12)
                    myarr(13) = mynumbers(x13, 13)
                    myarr(14) = mynumbers(x14, 14)
                    tot = myarr(1) + myarr(2) + myarr(3) + myarr(4) + myarr(5) + myarr(6) + myarr(7) + myarr(8) + myarr(9) + myarr(10) + myarr(11) + myarr(12) + myarr(13) + myarr(14)
                    If tot = mysum Then
                        lastrow = ActiveSheet.Cells(Rows.Count, 24).End(xlUp).Row
                        ActiveSheet.Range(Cells(lastrow + 1, 24), Cells(lastrow + 1, 37)).Value = myarr
                        ActiveSheet.Cells(lastrow + 1, 38).Value = tot
                    End If
                    DoEvents
                Next x14: Next x13
            Next x12:  Next x11: Next x10: Next x9
        Next x8: Next x7: Next x6: Next x5
    Next x4: Next x3: Next x2: Next x1
    MsgBox (Timer - T)
End Sub

None of sums lists more combinations than rows in excel 2000 worksheet.
Hope this helps

Have a nice rest of the day

Thank you B___P, I appreciate your support it is exactly as I wanted Amazing!! Code.

Doing the job quick and the results are 100% OK!!


Thank you very much

Good Night

Kind Regards,
Moti