Here is some code. Note that you need to create references to a couple of
librarys in order tom make this code work (In VBE select Tools -
References).

'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0 or higher

This code should be placed in a standard module...

Option Explicit
' Original solution created by
' Harlan Grove

Public Sub FindSums()
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0 or higher

Const TOL As Double = 0.0001 '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
Dim wks As Worksheet
Application.EnableCancelKey = xlErrorHandler

re.Global = True
re.IgnoreCase = True

On Error Resume Next

Set wks = ActiveSheet
Set x = Intersect(Selection, wks.UsedRange)

If x Is Nothing Then
Err.Clear
Exit Sub
End If

y = Application.InputBox( _
Prompt:="Enter target value:", _
Title:="Find Sums", _
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:
If Err = 18 Then
If MsgBox("Do you want to stop searching?", vbYesNo, "Quit?") = vbYes Then
Application.StatusBar = False
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End
Else
Resume
End If
Else
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End If
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
If Not SheetExists(OUTPUTWSN, ActiveWorkbook) Then
Application.ScreenUpdating = False
Worksheets.Add Befo=ActiveSheet
Set ws = ActiveSheet
ws.Name = OUTPUTWSN
ws.Cells.NumberFormat = "#,##0.00"
Set r = ws.Range("A2")
Else
Set ws = Sheets(OUTPUTWSN)
ws.Cells.Clear
ws.Cells.NumberFormat = "#,##0.00"
Set r = ws.Range("A2")
End If
recsoln = 0
ElseIf s = "" Then
recsoln = r.Row - 1
Set r = Nothing
Else
Call PostAnswers(s, r)
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

Private Sub PostAnswers(ByVal strValue As String, ByVal rng As Range)
Dim aryCSVValues As Variant
Dim intCounter As Integer

aryCSVValues = Split(Mid$(strValue, 2, Len(strValue)), "+")
For intCounter = LBound(aryCSVValues) To UBound(aryCSVValues)
rng.Value = aryCSVValues(intCounter)
Set rng = rng.Offset(0, 1)
Next intCounter
End Sub
--
HTH...

Jim Thomlinson


" wrote:

Hello,

I have a list of numbers in a column and I need to find which numbers
when summed together equal a figure. I have a list of invoice amounts
that I need to match up with payments (the payments are always made for
several invoices so I need to come up with sums of several invoices to
get to this payment amount).

An example would be I have this in the following section (A1:A10):
$17,213.82
$4,563.02
$85,693.42
$1,166.01
$725.90
$580.09
$2,243.75
$240.16
$207.70
$725.90

I need to find which combination of these figures would sum $1,173.76.

Thanks in Advance,
Dza the troubled accountant

Jim Thomlinson wrote...
....
Private Sub PostAnswers(ByVal strValue As String, ByVal rng As Range)
Dim aryCSVValues As Variant
Dim intCounter As Integer

aryCSVValues = Split(Mid$(strValue, 2, Len(strValue)), "+")
For intCounter = LBound(aryCSVValues) To UBound(aryCSVValues)
rng.Value = aryCSVValues(intCounter)
Set rng = rng.Offset(0, 1)
Next intCounter
End Sub
....

This is your code. You should have indicated that. You also made a few
modifications in my original procedures. I don't have an issue with you
modifying my code, just with the lack of any way to distinguish your
code from mine.

Off-topic: I hate long variable names. There's a problematic case for
them in long, complex procedures, but other than typing exercise I
don't see the usefulness in short procedures. Ah, for programmers'
editors in which different colors could be assigned to variable tokens
of different types!

Back on-topic. My own code is at

http://groups.google.com/group/micro...19858047398beb

Your comment in your other response in this thread is apt: N 30 makes
for LONG execution times, but the macro works for larger N. I haven't
torture-tested it, but the large N with skewed values (median value
outside mean +/- 25%) will almost certainly exceed most PC's memory
resources, real and virtual. I have a test case with N=100 cells filled
with values generated by =ROUND(RAND()^-4,2), in the particular case 68
of 100 values < 100, and sought 5000 as the sum. There were 129
combinations of 1 to 6 values summing to 5000 and 464 of 7 (when I
cancelled the macro). Not sure how much information there might be if
there were more than 1 million combinations summing to 5000. How would
anyone choose which one to use?

In other words, the programming was an interesting exercise, but I
still don't believe it provides any value.

My appologies for not documenting where I had made modifications to your
code... As a professional courtesy I should have done that and I will
endevour to make the necessary notations at my end. Thanks for sharing your
work and once again I appoligize.

As for long variable names I have always favoured them purely from a
readability standpoint. I have debugged too much code written by others that
was almost impossible to follow. Not to mention it keeps things straight in
my head when I am writing it. Probably more the latter than the former... :-)

--
HTH...

Jim Thomlinson


"Harlan Grove" wrote:

Jim Thomlinson wrote...
....
Private Sub PostAnswers(ByVal strValue As String, ByVal rng As Range)
Dim aryCSVValues As Variant
Dim intCounter As Integer

aryCSVValues = Split(Mid$(strValue, 2, Len(strValue)), "+")
For intCounter = LBound(aryCSVValues) To UBound(aryCSVValues)
rng.Value = aryCSVValues(intCounter)
Set rng = rng.Offset(0, 1)
Next intCounter
End Sub
....

This is your code. You should have indicated that. You also made a few
modifications in my original procedures. I don't have an issue with you
modifying my code, just with the lack of any way to distinguish your
code from mine.

Off-topic: I hate long variable names. There's a problematic case for
them in long, complex procedures, but other than typing exercise I
don't see the usefulness in short procedures. Ah, for programmers'
editors in which different colors could be assigned to variable tokens
of different types!

Back on-topic. My own code is at

http://groups.google.com/group/micro...19858047398beb

Your comment in your other response in this thread is apt: N 30 makes
for LONG execution times, but the macro works for larger N. I haven't
torture-tested it, but the large N with skewed values (median value
outside mean +/- 25%) will almost certainly exceed most PC's memory
resources, real and virtual. I have a test case with N=100 cells filled
with values generated by =ROUND(RAND()^-4,2), in the particular case 68
of 100 values < 100, and sought 5000 as the sum. There were 129
combinations of 1 to 6 values summing to 5000 and 464 of 7 (when I
cancelled the macro). Not sure how much information there might be if
there were more than 1 million combinations summing to 5000. How would
anyone choose which one to use?

In other words, the programming was an interesting exercise, but I
still don't believe it provides any value.

Hi Harlan. I love your "FindSum" program. It's excellent! Just for
feedback, in a permutation timing program that I have, I was coming up 1
number larger in the total number of solutions. Tracing the program back,
it appears to me that if the list is sorted, then the program misses the sum
of the first 'n' items. For example, if the op's data were sorted, then it
would miss finding the sum of the first two items (207.70+240.16 = 447.86)

A more simplier test might be with the number sequence 1,2,3...10. A
search for 3 might miss 1+2, or a search of 6 might miss 1+2+3.
Again, only if the data is sorted. I'm not sure at this point where in the
program to make a recommendation. Excellent code though. :)

--
Dana DeLouis
Win XP & Office 2003


"Harlan Grove" wrote in message
oups.com...
Jim Thomlinson wrote...
...
Private Sub PostAnswers(ByVal strValue As String, ByVal rng As Range)
Dim aryCSVValues As Variant
Dim intCounter As Integer

aryCSVValues = Split(Mid$(strValue, 2, Len(strValue)), "+")
For intCounter = LBound(aryCSVValues) To UBound(aryCSVValues)
rng.Value = aryCSVValues(intCounter)
Set rng = rng.Offset(0, 1)
Next intCounter
End Sub
...

This is your code. You should have indicated that. You also made a few
modifications in my original procedures. I don't have an issue with you
modifying my code, just with the lack of any way to distinguish your
code from mine.

Off-topic: I hate long variable names. There's a problematic case for
them in long, complex procedures, but other than typing exercise I
don't see the usefulness in short procedures. Ah, for programmers'
editors in which different colors could be assigned to variable tokens
of different types!

Back on-topic. My own code is at

http://groups.google.com/group/micro...19858047398beb

Your comment in your other response in this thread is apt: N 30 makes
for LONG execution times, but the macro works for larger N. I haven't
torture-tested it, but the large N with skewed values (median value
outside mean +/- 25%) will almost certainly exceed most PC's memory
resources, real and virtual. I have a test case with N=100 cells filled
with values generated by =ROUND(RAND()^-4,2), in the particular case 68
of 100 values < 100, and sought 5000 as the sum. There were 129
combinations of 1 to 6 values summing to 5000 and 464 of 7 (when I
cancelled the macro). Not sure how much information there might be if
there were more than 1 million combinations summing to 5000. How would
anyone choose which one to use?

In other words, the programming was an interesting exercise, but I
still don't believe it provides any value.