Find all possible sums of a given set of numbers

[gravanoc]

Imagine you have a list of numbers: 5, 15, 20, 10, 25, 30, 10. From that list you can choose how many of those numbers to add up so that they are the highest possible sum without exceeding a certain limit. For example, in situation #1 you are able to add 3 of them (no more, no less) so that they come out at a maximum sum that is less than 58. You couldn't choose 30 + 25 + 5, since the sum exceeds 58. 30 + 25 = 55 would be wrong because you only used 2 numbers. Your best choice would be 20 + 25 + 10 = 55. Situation #2 you are given the same list of numbers, but must add 4 of them together so that they do not exceed 71. That's the general pattern.

The list of numbers generated is random, the number of numbers to be added together is random, and the limit is random. How would I best go about determining a generalized way in either VBA or formulas to always return the best sum, or return Null if no such sum exists?

Thank you.

 

[EXCEL MAX]

Hello Gravanoc,
why 30, 15, 10 is not the best result? What result is right?

 

[gravanoc]

Sorry, I shouldn't have allowed the list to contain two correct answers. My mistake. You are correct though that would also be a valid answer.

 

[maabadi]

Write your Data at A column from A2 to down then run this code. you See result at column C to right side from row 2 to 4 for each group.

Sub SumForLimit()
Dim i As Long, Lr As Long, s As Long, m As Long, j As Long, k As Long
Dim x As Long, y As Long, z As Long, Lc As Long, a As Long, b As Long
 Lr = Cells(Rows.Count, 1).End(xlUp).Row
 Range("C2:X6").ClearContents
 i = Application.WorksheetFunction.Count(Range("A2:A" & Lr))
 For k = 3 To Lr - 1
 For j = 2 To Lr - 1
 For i = 1 To Lr - 1
 If j = k Then j = k + 1
 If i = j Then i = i + 2
 If i = k Then i = i + 1
 x = Range("A" & i + 1).Value
 y = Range("A" & j + 1).Value
 z = Range("A" & k + 1).Value
 s = Range("A" & i + 1).Value + Range("A" & j + 1).Value + Range("A" & k + 1).Value
 Debug.Print s
 If m <= s And s <= 58 Then
 Lc = Cells(2, Columns.Count).End(xlToLeft).Column
 Cells(2, Lc + 1).Value = x
 Cells(3, Lc + 1).Value = y
 Cells(4, Lc + 1).Value = z
 m = s
 Debug.Print m
 End If
 Next i
 Next j
 Next k
 Debug.Print m
 Lc = Cells(2, Columns.Count).End(xlToLeft).Column
 b = Application.WorksheetFunction.Sum(Range(Cells(2, Lc), Cells(4, Lc)))
 For j = 2 To Lc - 1
 a = Application.WorksheetFunction.Sum(Range(Cells(2, j), Cells(4, j)))
 If a < b Then
 Range(Cells(2, j), Cells(4, j)).ClearContents
 End If
 Next j
End Sub

 

[shg]

If the number of numbers n was reasonable (<=20), you could put a formula down 2^n rows that calculates each possible sums, and then sort by total.

 

[EXCEL MAX]

If you still not found the way to reslove your problem here is one UDF
that can calculate sums of all possible combinations and find max sum that is not greater then limit value.
Function have few error handling messages. You will very easy understand formula and learn to use it.
The function have 3 parameters.
First parameter - range with numbers in the sheet (one column). Remove non-numerical and empty cells.
Second parameter - the set of numbers.
Third paremeter - limit value.
Insert this code in the standard module and use it as any other function.

Dim vNC As Integer, vNR As Long
Dim vA()
Dim vR As Long, vR1 As Long, vR2 As Long
Dim vS As Double, vS2 As Double
Dim vMax As Double

Function MaxSum(vRange As Range, _
                vNumber As Integer, _
                vLimit As Long)
    
    vNC = vRange.Columns.Count
    If vNC > 1 Then GoTo ERR1
    vNR = vRange.Rows.Count
    ReDim Preserve vA(2 * vNR)
    For vR = 1 To vNR
        If Cells(vR + vRange.Row - 1, vRange.Column) = "" Then _
            GoTo ERR2
        If Not IsNumeric( _
            Cells(vR + vRange.Row - 1, vRange.Column)) Then _
            GoTo ERR3
        vA(vR) = Cells(vR + vRange.Row - 1, vRange.Column)
        vA(vNR + vR) = vA(vR)
    Next vR
    For vR1 = 1 To vNR
        For vR2 = vR1 To vNumber - 1 + vR1 - 1
            vS = vS + vA(vR2)
        Next vR2
        For vR2 = vNumber + vR1 - 1 To vR1 + (vNR - 1)
            vS2 = vS + vA(vR2)
            If vS2 < vLimit And vS2 > vMax Then _
                vMax = vS2
        Next vR2
        vS = 0
    Next vR1
    MaxSum = vMax
    vMax = 0
    Exit Function

ERR1: MsgBox "More then one column."
      MaxSum = "#MTOC"
      Exit Function
ERR2: MsgBox "Empty cell in the range."
      MaxSum = "#EC"
      Exit Function
ERR3: MsgBox "Non-numerical cell in the range."
      MaxSum = "#NNC"
      
End Function