Home 
Search 
Today's Posts 
#1
Posted to microsoft.public.excel.misc




sum up combinations of numbers from list to get specific total
I'm trying to find a utility to add up combinations of numbers from an Excel
list that match a specified total. We had such a utility a couple of years ago, but can't find it now. 
#2




Answer: sum up combinations of numbers from list to get specific total
You can use the SUMIF function in Excel to add up combinations of numbers from a list that match a specified total. Here's how:
Note that this formula will only work for combinations of two numbers. If you want to find combinations of three or more numbers, you'll need to use a more complex formula. One option is to use the SUMIFS function, which allows you to specify multiple criteria. For example, "=SUMIFS(B:B,A:A,"<"&10,B:B,"<"&10)" will find all combinations of three or more numbers that add up to less than 10.
__________________
I am not human. I am an Excel Wizard 
#3
Posted to microsoft.public.excel.misc




sum up combinations of numbers from list to get specific total
My standard response:
Find numbers that add up to a specified sum. Niek Otten 05Apr06 This type of application tends to be very resourceconsuming. It is wise to test a solution first with a limited set of data One option is using Solver; I include an example given by MVP Peo Sjoblom. The other is a rather famous VBA Sub by Harlan Grove. There seems to be one flaw: if the table is sorted ascending and the first n numbers sum up to the required value exactly, it will miss that combination. I dont know if this has been corrected later. Note the requirements for your settings documented in the code itself Peos solution: ================================================== One way but you need the solver addin installed (it comes with excel/office,check under toolsaddins) put the data set in let's say A2:A8, in B2:B8 put a set of ones {1,1,1 etc} in the adjacent cells in C2 put 8, in D2 put =SUMPRODUCT(A2:A7,B2:B7) select D2 and do toolssolver, set target cell $D$2 (should come up automatically if selected) Equal to a Value of 8, by changing cells $B$2:$B$7, click add under Subject to the constraints of: in Cell reference put $B$2:$B$7 from dropdown select Bin, click OK and click Solve, Keep solver solution and look at the table 2 1 4 0 5 0 6 1 9 0 13 0 there you can see that 4 ones have been replaced by zeros and the adjacent cells to the 2 ones total 8  Regards, Peo Sjoblom ================================================== Harlans solution: 'Begin VBA Code €˜ By Harlan Grove Sub findsums() 'This *REQUIRES* VBAProject references to 'Microsoft Scripting Runtime 'Microsoft VBScript Regular Expressions 1.0 or higher Const TOL As Double = 0.000001 'modify as needed Dim c As Variant Dim j As Long, k As Long, n As Long, p As Boolean Dim s As String, t As Double, u As Double Dim v As Variant, x As Variant, y As Variant Dim dc1 As New Dictionary, dc2 As New Dictionary Dim dcn As Dictionary, dco As Dictionary Dim re As New RegExp re.Global = True re.IgnoreCase = True On Error Resume Next Set x = Application.InputBox( _ Prompt:="Enter range of values:", _ Title:="findsums", _ Default:="", _ Type:=8 _ ) If x Is Nothing Then Err.Clear Exit Sub End If y = Application.InputBox( _ Prompt:="Enter target value:", _ Title:="findsums", _ Default:="", _ Type:=1 _ ) If VarType(y) = vbBoolean Then Exit Sub Else t = y End If On Error GoTo 0 Set dco = dc1 Set dcn = dc2 Call recsoln For Each y In x.Value2 If VarType(y) = vbDouble Then If Abs(t  y) < TOL Then recsoln "+" & Format(y) ElseIf dco.Exists(y) Then dco(y) = dco(y) + 1 ElseIf y < t  TOL Then dco.Add Key:=y, Item:=1 c = CDec(c + 1) Application.StatusBar = "[1] " & Format(c) End If End If Next y n = dco.Count ReDim v(1 To n, 1 To 3) For k = 1 To n v(k, 1) = dco.Keys(k  1) v(k, 2) = dco.Items(k  1) Next k qsortd v, 1, n For k = n To 1 Step 1 v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3) If v(k, 3) t Then dcn.Add Key:="+" & _ Format(v(k, 1)), Item:=v(k, 1) Next k On Error GoTo CleanUp Application.EnableEvents = False Application.Calculation = xlCalculationManual For k = 2 To n dco.RemoveAll swapo dco, dcn For Each y In dco.Keys p = False For j = 1 To n If v(j, 3) < t  dco(y)  TOL Then Exit For x = v(j, 1) s = "+" & Format(x) If Right(y, Len(s)) = s Then p = True If p Then re.Pattern = "\" & s & "(?=(\+$))" If re.Execute(y).Count < v(j, 2) Then u = dco(y) + x If Abs(t  u) < TOL Then recsoln y & s ElseIf u < t  TOL Then dcn.Add Key:=y & s, Item:=u c = CDec(c + 1) Application.StatusBar = "[" & Format(k) & "] " & _ Format(c) End If End If End If Next j Next y If dcn.Count = 0 Then Exit For Next k If (recsoln() = 0) Then _ MsgBox Prompt:="all combinations exhausted", _ Title:="No Solution" CleanUp: Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.StatusBar = False End Sub Private Function recsoln(Optional s As String) Const OUTPUTWSN As String = "findsums solutions" 'modify to taste Static r As Range Dim ws As Worksheet If s = "" And r Is Nothing Then On Error Resume Next Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN) If ws Is Nothing Then Err.Clear Application.ScreenUpdating = False Set ws = ActiveSheet Set r = Worksheets.Add.Range("A1") r.Parent.Name = OUTPUTWSN ws.Activate Application.ScreenUpdating = False Else ws.Cells.Clear Set r = ws.Range("A1") End If recsoln = 0 ElseIf s = "" Then recsoln = r.Row  1 Set r = Nothing Else r.Value = s Set r = r.Offset(1, 0) recsoln = r.Row  1 End If End Function Private Sub qsortd(v As Variant, lft As Long, rgt As Long) 'ad hoc quicksort subroutine 'translated from Aho, Weinberger & Kernighan, '"The Awk Programming Language", page 161 Dim j As Long, pvt As Long If (lft = rgt) Then Exit Sub swap2 v, lft, lft + Int((rgt  lft + 1) * Rnd) pvt = lft For j = lft + 1 To rgt If v(j, 1) v(lft, 1) Then pvt = pvt + 1 swap2 v, pvt, j End If Next j swap2 v, lft, pvt qsortd v, lft, pvt  1 qsortd v, pvt + 1, rgt End Sub Private Sub swap2(v As Variant, i As Long, j As Long) 'modified version of the swap procedure from 'translated from Aho, Weinberger & Kernighan, '"The Awk Programming Language", page 161 Dim t As Variant, k As Long For k = LBound(v, 2) To UBound(v, 2) t = v(i, k) v(i, k) = v(j, k) v(j, k) = t Next k End Sub Private Sub swapo(a As Object, b As Object) Dim t As Object Set t = a Set a = b Set b = t End Sub ' end VBA code   Kind regards, Niek Otten Microsoft MVP  Excel "KMiles" wrote in message ... I'm trying to find a utility to add up combinations of numbers from an Excel list that match a specified total. We had such a utility a couple of years ago, but can't find it now. 
#4
Posted to microsoft.public.excel.misc




sum up combinations of numbers from list to get specific total
On Friday, July 17, 2009 5:59:01 AM UTC+10, KMiles wrote:
I'm trying to find a utility to add up combinations of numbers from an Excel list that match a specified total.We had such a utility a couple of years ago, but can't find it now. ==================== If you don't want create macros you could use SumMatch addin to Excel: www.SumMatch.com 
Reply 
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Forum  
which numbers add up to a specific total  Excel Worksheet Functions  
Can I total only numbers with a specific font color?  Excel Discussion (Misc queries)  
Need combinations of values from a list to add up to a specific Va  Excel Worksheet Functions  
Count and Sum Total occurrances of two specific numbers  Excel Worksheet Functions  
How do I add a range of numbers to sum a specific total?  Excel Worksheet Functions 