How do I determine which data in a range add up to a fixed number?

How do i take a range of numbers and determine which numbers in the range add
up to 120? or as close to it as possible? I have list of 67 numbers totaling
710. I need to know which combination will add to 120 or as close to it as
possible, remove the first result, and repeat it until I have used all the
numbers

You can do this using Solver". Suppose the set of numbers is in A2:A68.
Enter 1 in each cell in B2 to B68. Place the single number (120) in C2.
Enter the following formula in some other cell (say C3)
=SUMPRODUCT(A2:A68,B2:B68)-C2 and click ENTER.

Now you are going to use Solver (the Solver add-in should be installed
for this) to find the combination of numbers in Column A whose total would be
equal to the single number you have entered in C2. To launch Solver, select
Tools Solver (Excel 2003) or Data ribbon Analysis section Solver
(Excel 2007). In the Solver Parameters window,

"Set Target Cell" $C$3
"Equal To" "Value of" 0
"By Changing Cells" $B$2:$B$68
"Subject to the Constraints"-- click "Add" -- enter $B$2:$B$68, select
"bin" from the popdown list (this adds a constraint which reads as
"$B$2:$B$68=binary")
Click "Solve"
The solver will find the solution by changing some of the 1's in Column B
to 0's. The set of Column A numbers for which Column B is 1 (and not 0) is
the solution for your problem. If the solution is satisfactory, click "Keep
Solver Solution". Note that if more than one solution is possible, Solver
will only find the first solution.

If the Solver button does not appear on the Data tab on the Ribbon (Excel
2007), click the Microsoft Office Button, Excel Options, Add-Ins category,
and then click the Go button. Then select the Solver Add-In check box, and
click OK to install it. Click Yes to confirm that you want to install the
Solver add-in.

Hope this helps,

Hutch

"Mray" wrote:

How do i take a range of numbers and determine which numbers in the range add
up to 120? or as close to it as possible? I have list of 67 numbers totaling
710. I need to know which combination will add to 120 or as close to it as
possible, remove the first result, and repeat it until I have used all the
numbers

=?Utf-8?B?VG9tIEh1dGNoaW5z?=
wrote in :

You can do this using Solver". Suppose the set of numbers is in
A2:A68. Enter 1 in each cell in B2 to B68. Place the single number
(120) in C2. Enter the following formula in some other cell (say C3)
=SUMPRODUCT(A2:A68,B2:B68)-C2 and click ENTER.

Now you are going to use Solver (the Solver add-in should be installed
for this) to find the combination of numbers in Column A whose total
would be equal to the single number you have entered in C2. To launch
Solver, select Tools Solver (Excel 2003) or Data ribbon Analysis
section Solver (Excel 2007). In the Solver Parameters window,

"Set Target Cell" $C$3
"Equal To" "Value of" 0
"By Changing Cells" $B$2:$B$68
"Subject to the Constraints"-- click "Add" -- enter $B$2:$B$68,
select "bin" from the popdown list (this adds a constraint which reads
as "$B$2:$B$68=binary")
Click "Solve"
The solver will find the solution by changing some of the 1's in
Column B to 0's. The set of Column A numbers for which Column B is 1
(and not 0) is the solution for your problem. If the solution is
satisfactory, click "Keep Solver Solution". Note that if more than
one solution is possible, Solver will only find the first solution.

If the Solver button does not appear on the Data tab on the Ribbon
(Excel 2007), click the Microsoft Office Button, Excel Options,
Add-Ins category, and then click the Go button. Then select the Solver
Add-In check box, and click OK to install it. Click Yes to confirm
that you want to install the Solver add-in.

Hope this helps,

Hutch

"Mray" wrote:

How do i take a range of numbers and determine which numbers in the
range add up to 120? or as close to it as possible? I have list of 67
numbers totaling 710. I need to know which combination will add to
120 or as close to it as possible, remove the first result, and
repeat it until I have used all the numbers

thats a great solution

Here is another solution. I adapted this code from a C-language program I
wrote forever ago. It won't necessarily find every possible solution, but it
can find multiple solutions (if they exist). The output is written to a new
sheet the macro adds at the end of the workbook.

To run the macro, select the range of 67 numbers. Then press Alt-F8 to bring
up a list of available macros. Select Knapsack OK. The macro will prompt
you for a target number. Enter 120 and click OK.

'Global variables for Knapsack
Public Type RngType
Nbr As Double 'Number in cell
Addr As String 'Address of cell
End Type
Public Cellz() As RngType, Targett As Double
Public Kount As Currency, RngCnt As Long, strTarget As String
Public Soln() As RngType, SolnCnt As Long
Public SolnNbr As Long, SolnRow As Long

Sub Knapsack()
'Calls function KS to find combinations of values
'within the selection that total the target number.
'Current LIMITS: only finds target numbers which
'are positive numbers; can find multiple solutions,
'but not necessarily every possible solution. Also,
'if the target is the sum of the only two numbers in the
'selection which are smaller than the target, it may not
'find the solution.
Dim c As Range, aa As Long, bb As Long, msg101 As String
Dim Temp() As RngType, NegFlag As Boolean, BigFlag As Boolean
On Error GoTo KSerr1
'Check if the selected range has 2 cells.
If Selection.Count 3 Then
MsgBox "You must select more than 2 cells", , "Are you kidding?"
Exit Sub
End If
'Get the target number from the user.
strTarget$ = InputBox("Enter the target amount")
If Len(strTarget$) = 0 Then Exit Sub
Targett# = CDbl(strTarget$)
'Load range to be checked into Cellz array.
'Store the address & value from each cell in the selected range.
RngCnt& = -1
For Each c In Selection
RngCnt& = RngCnt& + 1
ReDim Preserve Temp(RngCnt&)
Temp(RngCnt&).Addr = c.Address
Temp(RngCnt&).Nbr = c.Value
Next c
'Add one more dummy element to Cellz() to make sure last cell gets tested.
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Cellz(RngCnt& - 1).Addr
Cellz(RngCnt&).Nbr = 0
'See if there are any negative numbers or numbers larger than Targett# in
Temp().
BigFlag = False
NegFlag = False
For aa& = 0 To (RngCnt& - 1)
If Temp(aa&).Nbr 0 Then
NegFlag = True
ElseIf Temp(aa&).Nbr Targett# Then
BigFlag = True
End If
Next aa&
'If both NegFlag and BigFlag are True (or False),
'copy all elements of Temp() to Cellz(). If Negflag is False but
'BigFlag is True, copy only elements that are smaller than Targett#.
bb& = RngCnt& - 1
RngCnt& = -1
For aa& = 0 To bb&
If (BigFlag = True) And (NegFlag = False) Then
If (Temp(aa&).Nbr = Targett#) And (Temp(aa&).Nbr 0) Then
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(aa&).Addr
Cellz(RngCnt&).Nbr = Temp(aa&).Nbr
End If
Else
If Temp(aa&).Nbr 0 Then
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(aa&).Addr
Cellz(RngCnt&).Nbr = Temp(aa&).Nbr
End If
End If
Next aa&
'Add one more dummy element to Cellz() to make sure last cell gets tested.
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(RngCnt& - 1).Addr
Cellz(RngCnt&).Nbr = 0
'Set Kount@ and SolnNbr& to zero.
Kount@ = 0
SolnNbr& = 0
'First call to KS() starts the chain of recursive calls. The For..Next
'loop starts a new chain every time the previous chain returns a solution
'or False (no solution). Each new chain starts one element farther in
'Cellz(), to ensure that a different solution, if any, will be found.
'However, this means that the first element in Cellz() can only be in 1
'solution, the 2nd element can only be in 2 solutions, etc. So, we are
'still not finding every possible solution.
For bb& = 0 To (RngCnt& - 1)
SolnCnt& = -1
If KS(Cellz(bb&).Nbr, bb& + 1) Then
SolnNbr& = SolnNbr& + 1
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(bb&).Addr
Soln(SolnCnt&).Nbr = Cellz(bb&).Nbr
'Add a new worksheet to the current workbook at the end.
If SolnNbr& = 1 Then
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
SolnRow& = 1
Else
'Find the last row with data in column A.
Cells(65535, 1).Select
Selection.End(xlUp).Select
Selection.Offset(4, 0).Select
SolnRow& = Selection.Row
End If
'Stop before hitting the last row of the worksheet & abending.
If (SolnCnt& + SolnRow&) Rows.Count Then
MsgBox "Can't fit all the solutions on the sheet", , "Error"
Exit Sub
End If
'List the elements in Soln(), which make up the solution.
For aa& = 1 To SolnCnt&
ActiveSheet.Cells(aa& + SolnRow& + 2, 1).Value = Soln(aa&).Addr
ActiveSheet.Cells(aa& + SolnRow& + 2, 2).Value = Soln(aa&).Nbr
'Add some headings also.
Cells(SolnRow&, 1).Value = Targett#
Cells(SolnRow&, 2).Value = " = Target"
Cells(SolnRow& + 2, 1).Value = "Cell"
Cells(SolnRow& + 2, 2).Value = "Value"
Next aa&
End If
'Clear the array before the next iteration.
ReDim Soln(0)
Next bb&
'Find the last row with data in column A. 4 rows down, summarize the results.
If SolnNbr& 0 Then
Cells(65535, 1).Select
Selection.End(xlUp).Select
Selection.Offset(4, 0).Select
Selection.Value = SolnNbr& & _
" solutions were found. KS function was called " & Kount@ & " times."
End If
'Tell user we are done. Summarize results.
MsgBox SolnNbr& & _
" solutions were found. KS function was called " & Kount@ & " times.", ,
"Done!"
Exit Sub
KSerr1:
If Err.Number 0 Then
msg101$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg101$, , "Knapsack error", Err.HelpFile, Err.HelpContext
End If
End Sub

Public Function KS(yy As Double, xx As Long) As Boolean
'My own recursive AND iterative algorithm for the classic
'knapsack programming problem. yy& is the cumulative total
'tested against the target number in this call, and passed
'to the next call increased by the next element of Cellz().
Dim nn As Long
'Call DoEvents so the screen can refresh, etc.
DoEvents
'Add 1 to Kount every time function is called.
Kount@ = Kount@ + 1
'Start a loop to test all remaining values of Cellz[xx]
'from this point in the solution chain.
nn& = xx&
Do While nn& = RngCnt&
If (yy# = Targett#) Then
'Found a solution in this call! Increase Soln() and save info
'about the last element of Cellz() that was tried (nn&, which
'should always be the same as xx& at this point in the function).
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(nn&).Addr
Soln(SolnCnt&).Nbr = Cellz(nn&).Nbr
'Return True to the calling function.
KS = True
Exit Function
ElseIf (yy# Targett#) Then
'yy& in this call exceeds the target number. Return False to the
'calling function.
KS = False
Exit Function
'yy& is still less than the target number. Call KS() again, adding
'the next element in Cellz() to yy&
ElseIf (KS(yy# + Cellz(nn&).Nbr, nn& + 1)) Then
'The call to another element of Cellz() found a successful chain.
'Info about that element of Cellz() has already been saved in Soln().
'Now increase Soln() and store information about the Cellz() element
'in this call that is one link earlier in the solution chain.
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(nn&).Addr
Soln(SolnCnt&).Nbr = Cellz(nn&).Nbr
'Return True to the calling function.
KS = True
Exit Function
End If
nn& = nn& + 1
Loop
KS = False
End Function

Put the code in a general VBA module in your workbook. If you are
new to macros, this link to Jon Peltier's site may be helpful:
http://peltiertech.com/WordPress/200...e-elses-macro/

Some of the lines may wrap from being posted in the forum. The visiual basic
editor will color these red until you fix (unwrap) them.

Hope this helps,

Hutch

"Mray" wrote:

How do i take a range of numbers and determine which numbers in the range add
up to 120? or as close to it as possible? I have list of 67 numbers totaling
710. I need to know which combination will add to 120 or as close to it as
possible, remove the first result, and repeat it until I have used all the
numbers

Tom...

wow...its really great...
more fast and more choice...
thank you so much....

"Tom Hutchins" wrote:

Here is another solution. I adapted this code from a C-language program I
wrote forever ago. It won't necessarily find every possible solution, but it
can find multiple solutions (if they exist). The output is written to a new
sheet the macro adds at the end of the workbook.

To run the macro, select the range of 67 numbers. Then press Alt-F8 to bring
up a list of available macros. Select Knapsack OK. The macro will prompt
you for a target number. Enter 120 and click OK.

'Global variables for Knapsack
Public Type RngType
Nbr As Double 'Number in cell
Addr As String 'Address of cell
End Type
Public Cellz() As RngType, Targett As Double
Public Kount As Currency, RngCnt As Long, strTarget As String
Public Soln() As RngType, SolnCnt As Long
Public SolnNbr As Long, SolnRow As Long

Sub Knapsack()
'Calls function KS to find combinations of values
'within the selection that total the target number.
'Current LIMITS: only finds target numbers which
'are positive numbers; can find multiple solutions,
'but not necessarily every possible solution. Also,
'if the target is the sum of the only two numbers in the
'selection which are smaller than the target, it may not
'find the solution.
Dim c As Range, aa As Long, bb As Long, msg101 As String
Dim Temp() As RngType, NegFlag As Boolean, BigFlag As Boolean
On Error GoTo KSerr1
'Check if the selected range has 2 cells.
If Selection.Count 3 Then
MsgBox "You must select more than 2 cells", , "Are you kidding?"
Exit Sub
End If
'Get the target number from the user.
strTarget$ = InputBox("Enter the target amount")
If Len(strTarget$) = 0 Then Exit Sub
Targett# = CDbl(strTarget$)
'Load range to be checked into Cellz array.
'Store the address & value from each cell in the selected range.
RngCnt& = -1
For Each c In Selection
RngCnt& = RngCnt& + 1
ReDim Preserve Temp(RngCnt&)
Temp(RngCnt&).Addr = c.Address
Temp(RngCnt&).Nbr = c.Value
Next c
'Add one more dummy element to Cellz() to make sure last cell gets tested.
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Cellz(RngCnt& - 1).Addr
Cellz(RngCnt&).Nbr = 0
'See if there are any negative numbers or numbers larger than Targett# in
Temp().
BigFlag = False
NegFlag = False
For aa& = 0 To (RngCnt& - 1)
If Temp(aa&).Nbr 0 Then
NegFlag = True
ElseIf Temp(aa&).Nbr Targett# Then
BigFlag = True
End If
Next aa&
'If both NegFlag and BigFlag are True (or False),
'copy all elements of Temp() to Cellz(). If Negflag is False but
'BigFlag is True, copy only elements that are smaller than Targett#.
bb& = RngCnt& - 1
RngCnt& = -1
For aa& = 0 To bb&
If (BigFlag = True) And (NegFlag = False) Then
If (Temp(aa&).Nbr = Targett#) And (Temp(aa&).Nbr 0) Then
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(aa&).Addr
Cellz(RngCnt&).Nbr = Temp(aa&).Nbr
End If
Else
If Temp(aa&).Nbr 0 Then
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(aa&).Addr
Cellz(RngCnt&).Nbr = Temp(aa&).Nbr
End If
End If
Next aa&
'Add one more dummy element to Cellz() to make sure last cell gets tested.
RngCnt& = RngCnt& + 1
ReDim Preserve Cellz(RngCnt&)
Cellz(RngCnt&).Addr = Temp(RngCnt& - 1).Addr
Cellz(RngCnt&).Nbr = 0
'Set Kount@ and SolnNbr& to zero.
Kount@ = 0
SolnNbr& = 0
'First call to KS() starts the chain of recursive calls. The For..Next
'loop starts a new chain every time the previous chain returns a solution
'or False (no solution). Each new chain starts one element farther in
'Cellz(), to ensure that a different solution, if any, will be found.
'However, this means that the first element in Cellz() can only be in 1
'solution, the 2nd element can only be in 2 solutions, etc. So, we are
'still not finding every possible solution.
For bb& = 0 To (RngCnt& - 1)
SolnCnt& = -1
If KS(Cellz(bb&).Nbr, bb& + 1) Then
SolnNbr& = SolnNbr& + 1
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(bb&).Addr
Soln(SolnCnt&).Nbr = Cellz(bb&).Nbr
'Add a new worksheet to the current workbook at the end.
If SolnNbr& = 1 Then
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
SolnRow& = 1
Else
'Find the last row with data in column A.
Cells(65535, 1).Select
Selection.End(xlUp).Select
Selection.Offset(4, 0).Select
SolnRow& = Selection.Row
End If
'Stop before hitting the last row of the worksheet & abending.
If (SolnCnt& + SolnRow&) Rows.Count Then
MsgBox "Can't fit all the solutions on the sheet", , "Error"
Exit Sub
End If
'List the elements in Soln(), which make up the solution.
For aa& = 1 To SolnCnt&
ActiveSheet.Cells(aa& + SolnRow& + 2, 1).Value = Soln(aa&).Addr
ActiveSheet.Cells(aa& + SolnRow& + 2, 2).Value = Soln(aa&).Nbr
'Add some headings also.
Cells(SolnRow&, 1).Value = Targett#
Cells(SolnRow&, 2).Value = " = Target"
Cells(SolnRow& + 2, 1).Value = "Cell"
Cells(SolnRow& + 2, 2).Value = "Value"
Next aa&
End If
'Clear the array before the next iteration.
ReDim Soln(0)
Next bb&
'Find the last row with data in column A. 4 rows down, summarize the results.
If SolnNbr& 0 Then
Cells(65535, 1).Select
Selection.End(xlUp).Select
Selection.Offset(4, 0).Select
Selection.Value = SolnNbr& & _
" solutions were found. KS function was called " & Kount@ & " times."
End If
'Tell user we are done. Summarize results.
MsgBox SolnNbr& & _
" solutions were found. KS function was called " & Kount@ & " times.", ,
"Done!"
Exit Sub
KSerr1:
If Err.Number 0 Then
msg101$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg101$, , "Knapsack error", Err.HelpFile, Err.HelpContext
End If
End Sub

Public Function KS(yy As Double, xx As Long) As Boolean
'My own recursive AND iterative algorithm for the classic
'knapsack programming problem. yy& is the cumulative total
'tested against the target number in this call, and passed
'to the next call increased by the next element of Cellz().
Dim nn As Long
'Call DoEvents so the screen can refresh, etc.
DoEvents
'Add 1 to Kount every time function is called.
Kount@ = Kount@ + 1
'Start a loop to test all remaining values of Cellz[xx]
'from this point in the solution chain.
nn& = xx&
Do While nn& = RngCnt&
If (yy# = Targett#) Then
'Found a solution in this call! Increase Soln() and save info
'about the last element of Cellz() that was tried (nn&, which
'should always be the same as xx& at this point in the function).
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(nn&).Addr
Soln(SolnCnt&).Nbr = Cellz(nn&).Nbr
'Return True to the calling function.
KS = True
Exit Function
ElseIf (yy# Targett#) Then
'yy& in this call exceeds the target number. Return False to the
'calling function.
KS = False
Exit Function
'yy& is still less than the target number. Call KS() again, adding
'the next element in Cellz() to yy&
ElseIf (KS(yy# + Cellz(nn&).Nbr, nn& + 1)) Then
'The call to another element of Cellz() found a successful chain.
'Info about that element of Cellz() has already been saved in Soln().
'Now increase Soln() and store information about the Cellz() element
'in this call that is one link earlier in the solution chain.
SolnCnt& = SolnCnt& + 1
ReDim Preserve Soln(SolnCnt&)
Soln(SolnCnt&).Addr = Cellz(nn&).Addr
Soln(SolnCnt&).Nbr = Cellz(nn&).Nbr
'Return True to the calling function.
KS = True
Exit Function
End If
nn& = nn& + 1
Loop
KS = False
End Function

Put the code in a general VBA module in your workbook. If you are
new to macros, this link to Jon Peltier's site may be helpful:
http://peltiertech.com/WordPress/200...e-elses-macro/

Some of the lines may wrap from being posted in the forum. The visiual basic
editor will color these red until you fix (unwrap) them.

Hope this helps,

Hutch

"Mray" wrote:

How do i take a range of numbers and determine which numbers in the range add
up to 120? or as close to it as possible? I have list of 67 numbers totaling
710. I need to know which combination will add to 120 or as close to it as
possible, remove the first result, and repeat it until I have used all the
numbers

I'm using Excel 2003 and when I tried this the 1's were changed to decimals
not zeros - presumably because Solver was finding an exact solution rather
than, as the orginal post here requested, a 'nearest to zero' solution.

Any ideas on how to get this 'nearest to zero' solution?

Regards,

Tom-S


"Tom Hutchins" wrote:

You can do this using Solver". Suppose the set of numbers is in A2:A68.
Enter 1 in each cell in B2 to B68. Place the single number (120) in C2.
Enter the following formula in some other cell (say C3)
=SUMPRODUCT(A2:A68,B2:B68)-C2 and click ENTER.

Now you are going to use Solver (the Solver add-in should be installed
for this) to find the combination of numbers in Column A whose total would be
equal to the single number you have entered in C2. To launch Solver, select
Tools Solver (Excel 2003) or Data ribbon Analysis section Solver
(Excel 2007). In the Solver Parameters window,

"Set Target Cell" $C$3
"Equal To" "Value of" 0
"By Changing Cells" $B$2:$B$68
"Subject to the Constraints"-- click "Add" -- enter $B$2:$B$68, select
"bin" from the popdown list (this adds a constraint which reads as
"$B$2:$B$68=binary")
Click "Solve"
The solver will find the solution by changing some of the 1's in Column B
to 0's. The set of Column A numbers for which Column B is 1 (and not 0) is
the solution for your problem. If the solution is satisfactory, click "Keep
Solver Solution". Note that if more than one solution is possible, Solver
will only find the first solution.

If the Solver button does not appear on the Data tab on the Ribbon (Excel
2007), click the Microsoft Office Button, Excel Options, Add-Ins category,
and then click the Go button. Then select the Solver Add-In check box, and
click OK to install it. Click Yes to confirm that you want to install the
Solver add-in.

Hope this helps,

Hutch

"Mray" wrote:

How do i take a range of numbers and determine which numbers in the range add
up to 120? or as close to it as possible? I have list of 67 numbers totaling
710. I need to know which combination will add to 120 or as close to it as
possible, remove the first result, and repeat it until I have used all the
numbers