Excel Combinations

[jamiensurrey]

Does anyone know of a macro that can take a list of numbers and see if it matches another in any combination.

i.e

any combination of these numbers

1,791.81
23,371.48
11,685.72
2,508.53
3,583.62
7,167.24
5,375.43
1,480.19
2,866.90
2,165.75
3,583.62
2,508.53
1,558.10

will equal this number + or - 1.00
39,139.39

Thanks!

 

[BrianB]

This shows the principle :-
http://www.mrexcel.com/board2/viewtopic.php?t=151526&highlight=

 

[just_jon]

See this fine posting.

 

[jamiensurrey]

Thanks it works, but I want to put in 1.00 + or - margin of error, how could i do this to this code:

Option Explicit

'These private variables are used by the AddsUp macro
Private Target As Double ' The target total we're aiming for
Private EndRow As Integer ' The last row of the value list
Private Limit As Integer ' sum no more than this many cells
Private OutRow As Integer ' The row for the next output line

Sub AddsUp()
' *** Results in column C - change to suit ***
Columns(3).Clear
' *** Required answer - change reference to suit ***
Target = Range("B1").Value
' *** The last row in the list of values - change Range reference to suit ***
EndRow = Range("A1").End(xlDown).Row
' You can change the next two values
Limit = 20 ' Max number of cells to be summed
OutRow = 1 ' The row for the next output line
' You can change the first argument in the function call that follows.
' Doing so will change the starting row. Do not change the other
' three arguments
Add1 1, 0, "", 0
End Sub

Private Sub Add1(ByVal BegRow As Integer, ByVal SumSoFar As Double, _
ByVal OutSoFar As String, ByVal Num As Integer)
'This subroutine is called once by the AddsUp macro, to get the process
'started. It then calls itself recursively as many times as needed.
'
'BegRow - the first row that will be tested
'SumSoFar - the sum of all cells under consideration
'OutSoFar - the addresses of all cells under consideration
'Num - the number of cells under consideration
Dim ThisRow As Long
Dim OneA As String
If (BegRow <= EndRow) And (SumSoFar < Target) And (Num < Limit) Then
For ThisRow = BegRow To EndRow
OneA = Cells(ThisRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
If OutSoFar <> "" Then
OneA = " + " & OneA
End If
' If the current cell's value plus the sum so far equals
' the target, then we have found an answer. Display it
' in the current output row, and set OutRow to the next row
If (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) = Target) And (Num > 0) Then
Cells(OutRow, 3).Value = OutSoFar & OneA
OutRow = OutRow + 1
Else
' If the current cell's value plus the sum so far does not
' equal the target value, call this function again, starting
' in the row after ThisRow
Add1 ThisRow + 1, Round(SumSoFar + Cells(ThisRow, 1).Value, 2), _
OutSoFar & OneA, Num + 1
End If
Next ThisRow
End If
End Sub



cheers

 

[jamiensurrey]

Combinations of Negative and Positive Numbers

Is there a way of handling positive and negative numbers as some amounts might net off others to still match the target value?

This is the code I am using

Option Explicit

'These private variables are used by the AddsUp macro
Private Target As Double ' The target total we're aiming for
Private EndRow As Integer ' The last row of the value list
Private Limit As Integer ' sum no more than this many cells
Private OutRow As Integer ' The row for the next output line

Sub AddsUp()
' *** Results in column C - change to suit ***
Columns(3).Clear
' *** Required answer - change reference to suit ***
Target = Range("B1").Value
' *** The last row in the list of values - change Range reference to suit ***
EndRow = Range("A1").End(xlDown).Row
' You can change the next two values
Limit = 20 ' Max number of cells to be summed
OutRow = 1 ' The row for the next output line
' You can change the first argument in the function call that follows.
' Doing so will change the starting row. Do not change the other
' three arguments
Add1 1, 0, "", 0
End Sub

Private Sub Add1(ByVal BegRow As Integer, ByVal SumSoFar As Double, _
ByVal OutSoFar As String, ByVal Num As Integer)
'This subroutine is called once by the AddsUp macro, to get the process
'started. It then calls itself recursively as many times as needed.
'
'BegRow - the first row that will be tested
'SumSoFar - the sum of all cells under consideration
'OutSoFar - the addresses of all cells under consideration
'Num - the number of cells under consideration
Dim ThisRow As Long
Dim OneA As String
If (BegRow <= EndRow) And (SumSoFar < Target) And (Num < Limit) Then
For ThisRow = BegRow To EndRow
OneA = Cells(ThisRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
If OutSoFar <> "" Then
OneA = " + " & OneA
End If
' If the current cell's value plus the sum so far equals
' the target, then we have found an answer. Display it
' in the current output row, and set OutRow to the next row
If (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) < Target + 1) And (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) > Target - 1) And (Num > 0) Then
Cells(OutRow, 3).Value = OutSoFar & OneA
OutRow = OutRow + 1
Else
' If the current cell's value plus the sum so far does not
' equal the target value, call this function again, starting
' in the row after ThisRow
Add1 ThisRow + 1, Round(SumSoFar + Cells(ThisRow, 1).Value, 2), _
OutSoFar & OneA, Num + 1
End If
Next ThisRow
End If
End Sub

Thanks!

 

[just_jon]

Accounting for +/- offsetting values, well don'y know how to work that as either one by itself might be part of the only correct solution, eh?

This posting at Google.groups has Harlan Grove's code, its down a bit in the thread - make sure to get his final revision.

And BE SURE to pay attention to comments like these ...

It may take a LONG TIME, but if there's pronounced variance in your 150
number set, then many branches of combinations should be eliminated
quickly. However, it's impossible to say for sure whether my macro
would fail or not. Worst case, you won't have sufficient memory to
store the intermediate combinations.