“It’s not that I’m so smart, it’s just that I stay with problems longer.” [Albert Einstein]

## Abstract

Mr Excel’s challenge of the month of August 2002 stated:

“An accounts receivable department receives a check from a customer for \$4,556.92. Upon looking in the accounting system, there are 54 unpaid invoices, ranging from \$77.74 to \$5,465.45. The payment must be for some exact combination of entire invoices, but we don’t know which invoices are being paid.”

The winning solution was published (external link!) here. Michael Schwimmer presented a nice and elegant solution on his (now retired) website - in German. I translated his version into English because I found it really beautiful. Any errors are mine, I am sure. ## Appendix – cmbCalculate_Click Code

``````Private Sub cmbCalculate_Click()

Dim dGoal As Double
Dim dTolerance As Double
Dim dAmounts() As Double
Dim vResult As Variant
Dim m As Long
Dim n As Long

With Me

dGoal = .Range("B2")
dTolerance = .Range("C2")
ReDim dAmounts(1 To 100)
For m = 2 To 101
If (.Cells(m, 1) <> "") And (IsNumeric(.Cells(m, 1))) Then
dAmounts(m - 1) = .Cells(m, 1)
Else
ReDim Preserve dAmounts(1 To m - 1)
Exit For
End If
Next
ReDim Preserve dAmounts(1 To UBound(dAmounts) - 1)

vResult = Combinations(dAmounts, dGoal, dTolerance)
Application.ScreenUpdating = False
.Range("D3:D65536").ClearContents
.Range(.Cells(3, 4), .Cells(UBound(vResult) + 3, 4)) = vResult
Application.ScreenUpdating = True

End With

End Sub

Function Combinations( _
Elements As Variant, _
Goal As Double, _
Optional Tolerance As Double, _
Optional SoFar As Variant, _
Optional Position As Long) As Variant

Dim i             As Long
Dim k             As Long
Dim dCompare  As Double
Dim dDummy      As Double
Dim vDummy      As Variant
Dim vResult     As Variant

If Not IsMissing(SoFar) Then

'Sum of elements so far
For Each vDummy In SoFar
dCompare = dCompare + vDummy
Next

Else

'Start elements sorted by amount
For i = 1 To UBound(Elements)
For k = i + 1 To UBound(Elements)
If Elements(k) < Elements(i) Then
dDummy = Elements(i)
Elements(i) = Elements(k)
Elements(k) = dDummy
End If
Next
Next

Set SoFar = New Collection

End If

If Position = 0 Then Position = LBound(Elements)
For i = Position To UBound(Elements)

dCompare = dCompare + Elements(i)

If Abs(Goal - dCompare) < (0.001 + Tolerance) Then

'Goal achieved
k = 0
ReDim vResult(0 To SoFar.Count - 1, 0)
For Each vDummy In SoFar
vResult(k, 0) = vDummy
k = k + 1
Next
Combinations = vResult
Exit For

ElseIf dCompare < (Goal + 0.001 + Tolerance) Then
'Enough room for another element
'Call recursively starting with next higher amount
vResult = Combinations(Elements, Goal, Tolerance, SoFar, i + 1)
If IsArray(vResult) Then
Combinations = vResult
Exit For
Else
SoFar.Remove SoFar.Count
dCompare = dCompare - Elements(i)
End If

Else

'Amount too high
SoFar.Remove SoFar.Count
Exit For

End If

Next 'Try next higher amount

End Function
``````