Five Values that Equal a Sum Value

[ststern45]

Hi Everyone,
Happy New Year 2025

I have a set of 30 values below:
There are duplicate values in the list below. Example: 1, 2, 3 etc.
The minimum value total is 5 (1,1,1,1,1) and the maximum equal 73 (10,11,12,16,24)
So the range is from 5 to 73.

I would like to calculate how many 5 number values would equal sum of 5, 6, 7, .... 73

Thank you!!

1
1
1
1
1
2
2
2
2
3
3
3
3
4
4
5
5
5
5
5
6
6
7
8
8
10
11
12
16
24

 

[NdNoviceHlp]

Hi ststern45. So after you get the 5 lowest numbers summed and your 5 highest numbers summed and from that you have a new range of numbers (ie. 5 to 73) how do you display the 5 number combinations from Column "A" that equal your numbers in your new range? Also, why would you want/need to do this? Dave

 

[ststern45]

I found the following code which works for finding the sum of 1 number such as 5 or 73.
The hard part is finding the sums from 6 through 72.
In addition, having a list that has duplicate values such as 1's, 2's, 3's etc.

This is the code from ablebits.

This is how it should look below: Sum Values to the left and total sets per sum value on the right.
I used a longer method to come up with the values below but looking for a quicker/easier way to generate the sets.
Thank you.

Sums Total Sets
5 1
6 0
7 2
8 3
9 5
10 9
11 12
12 18
13 30
14 40
15 55
16 71
17 96
18 128
19 164
20 211
21 241
22 303
23 358
24 443
25 496
26 603
27 693
28 827
29 924
30 1065
31 1163
32 1321
33 1456
34 1628
35 1762
36 1938
37 2115
38 2302
39 2464
40 2641
41 2826
42 2979
43 3136
44 3270
45 3472
46 3676
47 3966
48 4245
49 4602
50 4920
51 5299
52 5532
53 5793
54 5903
55 6065
56 6067
57 6025
58 5802
59 5610
60 5237
61 4813
62 4257
63 3674
64 3007
65 2356
66 1756
67 1179
68 730
69 410
70 210
71 80
72 20
73 1

Option Explicit

Public Function FindSumCombinations(rngNumbers As Range, lTargetSum As Long)
Dim arNumbers() As Long, part() As Long
Dim arRes() As String
Dim indI As Long
Dim cellCurr As Range

ReDim arRes(0)
If rngNumbers.Count > 1 Then
ReDim arNumbers(rngNumbers.Count - 1)

indI = 0
For Each cellCurr In rngNumbers
arNumbers(indI) = CLng(cellCurr.Value)
indI = indI + 1
Next cellCurr
Call SumUpRecursiveCombinations(arNumbers, lTargetSum, part(), arRes())
End If
ReDim Preserve arRes(0 To UBound(arRes) - 1)
FindSumCombinations = arRes
End Function

 

[NdNoviceHlp]

Maybe I'm misunderstanding, the total set are each 1 group of 5 different numbers from "A" that sum to the Sums number. + 6000 different combinations/ number sets are available in "A" to make your Sums 55 to 57? Seems incredible. How did you get the total sets? Do you not want to display the number sets somewhere? Dave

 

[ststern45]

There a total of 30 numbers from 1 through 30 that each have their own unique value.
This list below is sorted in ascending order from 1 through 30
Left side are the numbers from 1 through 30 and the right side with the values pertaining to each of the numbers 1 through 30
# Value
1 12
2 7
3 1
4 9
5 8
6 5
7 7
8 4
9 6
10 1
11 17
12 4
13 25
14 4
15 6
16 4
17 3
18 1
19 3
20 13
21 11
22 1
23 9
24 6
25 6
26 1
27 6
28 3
29 3
30 5

 

[ststern45]

This is the same list with the values on the left sorted from low to high:
# Value
26 1
22 1
18 1
10 1
3 1
29 3
28 3
19 3
17 3
16 4
14 4
12 4
8 4
30 5
6 5
27 6
25 6
24 6
15 6
9 6
7 7
2 7
5 8
23 9
4 9
21 11
1 12
20 13
11 17
13 25

 

[ststern45]

This was the chart posted in the opening post:
If you total the values on the right it would total 142,506
Sums Totals
5 1
6 0
7 2
8 3
9 5
10 9
11 12
12 18
13 30
14 40
15 55
16 71
17 96
18 128
19 164
20 211
21 241
22 303
23 358
24 443
25 496
26 603
27 693
28 827
29 924
30 1065
31 1163
32 1321
33 1456
34 1628
35 1762
36 1938
37 2115
38 2302
39 2464
40 2641
41 2826
42 2979
43 3136
44 3270
45 3472
46 3676
47 3966
48 4245
49 4602
50 4920
51 5299
52 5532
53 5793
54 5903
55 6065
56 6067
57 6025
58 5802
59 5610
60 5237
61 4813
62 4257
63 3674
64 3007
65 2356
66 1756
67 1179
68 730
69 410
70 210
71 80
72 20
73 1
72 20
73 1

 

[ststern45]

The "long" method I used was to create all 5 number sets in Excel from 1 through 30 which totals 142,506. =combin(30,5)
1>Each 5 number set starting with 1, 2, 3, 4, 5 would also have the values that match. So in this example 1,2,3,4,5 the values would be 12, 7, 1, 9, 8 = sum total 37
2>This continues until the last set of 26, 27, 28, 29, 30 and their matching values (see list from the last few posts. 1, 6, 3, 3, 5 = sum total 18
3>The "long" calculations tally all 142,506 five numbers sets and their sum totals then count the totals for each sum totals from 5 though 73
4>Using the previous list, the sum value 37 occurred 2115 times and the sum total 18 occurred 128 times.

 

[ststern45]

This is the code below used to create all 142,506 sets.
Once all 142,506 sets are created I just match the values on the right from the list below to the values 1 through 30.
# Value
1 12
2 7
3 1
4 9
5 8
6 5
7 7
8 4
9 6
10 1
11 17
12 4
13 25
14 4
15 6
16 4
17 3
18 1
19 3
20 13
21 11
22 1
23 9
24 6
25 6
26 1
27 6
28 3
29 3
30 5


Option Explicit
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer
Dim N As Long, nMinA As Integer, nMaxE As Integer

Sub List_5x30Comb()

' Macro to list combinations in an Excel sheet
Sheets("530Sets").Select
Range("A1").Select
Application.ScreenUpdating = False
N = 1
Selection.ColumnWidth = 10
ActiveCell.Value = "Combinations"

' Change minimum value for A or maximum value for F
' to cover range of values to be covered
nMinA = 1
nMaxE = 30

' Start of loops for 5 variables (A-E)
For A = nMinA To nMaxE - 4
For B = A + 1 To nMaxE - 3
For C = B + 1 To nMaxE - 2
For D = C + 1 To nMaxE - 1
For E = D + 1 To nMaxE


' Copying the combination in the form N1-N2-N3-N4-N5-N6 in a cell
ActiveCell.Offset(1, 0).Select
N = N + 1
ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "," _
& Application.WorksheetFunction.Text(B, "00") & "," _
& Application.WorksheetFunction.Text(C, "00") & "," _
& Application.WorksheetFunction.Text(D, "00") & "," _
& Application.WorksheetFunction.Text(E, "00")


Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
End Sub

 

[StephenCrump]

Here's one way to generate the full set. The results match yours in Post #7, but yours are upside down.

	A	B	C
1	Numbers	Results
2	1	5	1
3	1	6	20
4	1	7	80
5	1	8	210
6	1	9	410
7	2	10	730
8	2	11	1,179
9	2	12	1,756
10	2	13	2,356
11	3	14	3,007
12	3	15	3,674
13	3	16	4,257
14	3	17	4,813
15	4	18	5,237
16	4	19	5,610
17	5	20	5,802
18	5	21	6,025
19	5	22	6,067
20	5	23	6,065
21	5	24	5,903
22	6	25	5,793
23	6	26	5,532
24	7	27	5,299
25	8	28	4,920
26	8	29	4,602
27	10	30	4,245
28	11	31	3,966
29	12	32	3,676
30	16	33	3,472
31	24	34	3,270
32		35	3,136
33		36	2,979
34		37	2,826
35		38	2,641
36		39	2,464
37		40	2,302
38		41	2,115
39		42	1,938
40		43	1,762
41		44	1,628
42		45	1,456
43		46	1,321
44		47	1,163
45		48	1,065
46		49	924
47		50	827
48		51	693
49		52	603
50		53	496
51		54	443
52		55	358
53		56	303
54		57	241
55		58	211
56		59	164
57		60	128
58		61	96
59		62	71
60		63	55
61		64	40
62		65	30
63		66	18
64		67	12
65		68	9
66		69	5
67		70	3
68		71	2
69		72	0
70		73	1
Sheet1

Sub Test()

    Dim MyNumbers As Variant
    Dim MyIntegers() As Long, MyCombinations() As Long, MySum As Long, i As Long, j As Long, k As Long, N As Long, MyMin As Long, MyMax As Long, Results() As Long
    
    MyNumbers = Range("A2:A31").Value
    N = UBound(MyNumbers)
    k = 5
    'Convert to Long for speed
    ReDim MyIntegers(1 To N)
    For i = 1 To N
        MyIntegers(i) = MyNumbers(i, 1)
    Next i
    
    MyCombinations = GetCombinations(N, k)
    
    'Assumes MyIntegers are in ascending order
    For i = 1 To k
        MyMin = MyMin + MyIntegers(i)
        MyMax = MyMax + MyIntegers(N - i + 1)
    Next i
    ReDim Results(MyMin To MyMax, 1 To 2)
    For i = MyMin To MyMax
        Results(i, 1) = i
    Next i
        
    For i = 1 To UBound(MyCombinations)
        For j = 1 To k
            MySum = MySum + MyIntegers(MyCombinations(i, j))
        Next j
        Results(MySum, 2) = Results(MySum, 2) + 1
        MySum = 0
    Next i

    Range("B2").Resize(UBound(Results) - LBound(Results) + 1, UBound(Results, 2)).Value = Results

End Sub
Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

    Dim lOutput() As Long, lCombinations As Long
    Dim i As Long, j As Long, k As Long
    
    lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
    ReDim lOutput(1 To lCombinations, 1 To lNoChosen)
    
    For i = 1 To lNoChosen
        lOutput(1, i) = i
    Next i
    
    For i = 2 To lCombinations
        For j = 1 To lNoChosen
            lOutput(i, j) = lOutput(i - 1, j)
        Next j
        For j = lNoChosen To 1 Step -1
            lOutput(i, j) = lOutput(i, j) + 1
            If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
        Next j
        For k = j + 1 To lNoChosen
            lOutput(i, k) = lOutput(i, k - 1) + 1
        Next k
    Next i
    
    GetCombinations = lOutput
    
End Function