Create summary without generating total of combinations by each sum

[motilulla]

Hello, I got a code to By Marcelo Branco, which generate all-possible sets using following layout under this link is superb! The summary below I got generating all combinations with the code and then counting by sum as shown in the Column H:J
https://www.mrexcel.com/forum/excel-questions/1093756-combine-all-products-different-varieties-2.html#post5261054

But I want a separate code, which can make an only summary without generating any combinations as shown in the column H:J with given example data in the range D5:F12 Example data...

	A	B	C	D	E	F	G	H	I
1				Min Sum	135
2				Max Sum	476				Total
3								With	Combination
4				Price $	Price $	Price $		Sum	6561
5				9	13	78		135	1
6				23	34	43		136	1
7				5	84	11		137	0
8				59	26	15		138	1
9				12	20	68		139	1
10				27	33	40		140	1
11				33	32	35		141	2
12				12	69	19		142	4
13								143	2
14								144	3
15								145	3
16								146	6
17								147	5
18								148	7
19								149	8
20								150	7

<tbody>
</tbody>

Thanks In Advance
Using version 2000
Regards, Moti

 

[motilulla]

Bump

 

[motilulla]

Bump

 

[motilulla]

</SPAN>Hello, many hours trying to find a solution of my query, did all possible search within MrExcel found just one code line, adding code line modifying Marcelo Branco code as shown below now it generate only all sum in the column K from min 135 to max 476 but cant find any way to get to get summary only unique sums and count of them as I want in the column H:I without generating all sum in the column K </SPAN></SPAN>

Please help</SPAN></SPAN>
Modified code...</SPAN></SPAN>

Sub aTestV2_Summary()
    
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), lLin As Long
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    lLin = 4
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    
                     Xsum = WorksheetFunction.Sum(myArr) ' Added New Line
                    
                     lLin = lLin + 1
                    'Range("I" & lLin).Resize(, 8) = myArr 'Changed This Code Line With Below Line
                     
                     Range("K" & lLin).Resize(, 1) = Xsum ' Added New Line
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    
    'With Range("Q5:Q" & lLin)
        '.Formula = "=SUM(I5:P5)"
        '.Value = .Value
    'End With
    'Optional - sort ascending
    SortResults lLin
End Sub
Sub SortResults(lr As Long)
    Range("K4:I" & lr).Sort key1:=Range("K4"), order1:=xlAscending, Header:=xlYes
End Sub

Result only summary required in the columns H:I</SPAN></SPAN>

Book1
	A	B	C	D	E	F	G	H	I	J	K
1				Min Sum	135
2				Max Sum	476			Summary	Count
3								Unique	Combination		With
4				Price $	Price $	Price $		Sums	6561		Sum
5				9	13	78		135	1		135
6				23	34	43		136	1		136
7				5	84	11		137	0		138
8				59	26	15		138	1		139
9				12	20	68		139	1		140
10				27	33	40		140	1		141
11				33	32	35		141	2		141
12				12	69	19		142	4		142
13								143	2		142
14								144	3		142
15								145	3		142
16								146	6		143
17								147	5		143
18								148	7		144
19								149	8		144
20								150	7		144
21								151	7		145
22								152	10		145
23								153	14		145
24								154	10		146
25								155	15		146
26								156	14		146
27								157	15		146
28								158	12		146
29								159	22		146
30								160	19		147
31								161	19		147
32								162	20		147
33								163	22		147
34								164	21		147
35								165	20		148
36								166	28		148
37								167	24		148
38								168	25		148
39								169	21		148
40								170	29		148
41								171	22		148
42								172	26		149
43								173	26		149
44								174	27		149
45								175	21		149
46								176	23		149
47								177	26		149
48								178	20		149
49								179	25		149
50								180	22		150
51								181	22		150
52								182	16		150
53								183	21		150
54											150
55											150
56											150
Sheet2

Thanks In Advance</SPAN></SPAN>
Using version 2000</SPAN></SPAN>
Regards, </SPAN></SPAN>
Moti</SPAN></SPAN>

 

[motilulla]

Bump

 

[motilulla]

Bump

Bump

 

[motilulla]

Bump

 

[motilulla]

Hello, I found in my archive that the StephenCrump, make a macro which get summary of lottery 6_49 without generating the combinations. I tried to understand the code and make a modification to apply with my requirements to this thread but I felt it is impossible for me.</SPAN></SPAN>

https://www.mrexcel.com/forum/excel...te-lottery-combinations-sums.html#post4586865

</SPAN></SPAN>
Please need your help
</SPAN>
</SPAN>Thank you in advance

Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[motilulla]

Bump

 

[Marcelo Branco]

Try

Sub aTestV2_Summary()
    Dim pa As Variant, pb As Variant, pc As Variant, pd As Variant
    Dim pe As Variant, pf As Variant, pg As Variant, ph As Variant
    Dim i As Long, j As Long, k As Long, l As Long
    Dim m As Long, n As Long, o As Long, p As Long
    Dim myArr(1 To 8), xSum As Long
    Dim ArrRes() As Variant
    
    pa = Range("D5:F5")
    pb = Range("D6:F6")
    pc = Range("D7:F7")
    pd = Range("D8:F8")
    pe = Range("D9:F9")
    pf = Range("D10:F10")
    pg = Range("D11:F11")
    ph = Range("D12:F12")
    
    ReDim ArrRes(Range("E1").Value To Range("E2").Value, 1 To 2)
    For i = Range("E1").Value To Range("E2").Value
        ArrRes(i, 1) = i
        ArrRes(i, 2) = 0
    Next i
    
    For i = 1 To 3
      For j = 1 To 3
        For k = 1 To 3
          For l = 1 To 3
            For m = 1 To 3
              For n = 1 To 3
                For o = 1 To 3
                  For p = 1 To 3
                    myArr(1) = pa(1, i)
                    myArr(2) = pb(1, j)
                    myArr(3) = pc(1, k)
                    myArr(4) = pd(1, l)
                    myArr(5) = pe(1, m)
                    myArr(6) = pf(1, n)
                    myArr(7) = pg(1, o)
                    myArr(8) = ph(1, p)
                    xSum = WorksheetFunction.Sum(myArr)
                    ArrRes(xSum, 2) = ArrRes(xSum, 2) + 1
                  Next p
                Next o
              Next n
            Next m
          Next l
        Next k
      Next j
    Next i
    Range("H5").Resize(Range("E2").Value - Range("E1").Value + 1, 2) = ArrRes
End Sub

M.