"It's not that I'm so smart, it's just that I stay with problems longer." [Albert Einstein]
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 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.
Tushar Mehta presents a nice algorithm (which can calculate all solutions if you got the time) here.
Please read my Disclaimer.
Private Sub cmbCalculate_Click()Dim dGoal As DoubleDim dTolerance As DoubleDim dAmounts() As DoubleDim vResult As VariantDim m As LongDim n As LongWith MedGoal = .Range("B2")dTolerance = .Range("C2")ReDim dAmounts(1 To 100)For m = 2 To 101If (.Cells(m, 1) <> "") And (IsNumeric(.Cells(m, 1))) ThendAmounts(m - 1) = .Cells(m, 1)ElseReDim Preserve dAmounts(1 To m - 1)Exit ForEnd IfNextReDim 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)) = vResultApplication.ScreenUpdating = TrueEnd WithEnd SubFunction Combinations( _Elements As Variant, _Goal As Double, _Optional Tolerance As Double, _Optional SoFar As Variant, _Optional Position As Long) As VariantDim i As LongDim k As LongDim dCompare As DoubleDim dDummy As DoubleDim vDummy As VariantDim vResult As VariantIf Not IsMissing(SoFar) Then'Sum of elements so farFor Each vDummy In SoFardCompare = dCompare + vDummyNextElse'Start elements sorted by amountFor i = 1 To UBound(Elements)For k = i + 1 To UBound(Elements)If Elements(k) < Elements(i) ThendDummy = Elements(i)Elements(i) = Elements(k)Elements(k) = dDummyEnd IfNextNextSet SoFar = New CollectionEnd IfIf Position = 0 Then Position = LBound(Elements)For i = Position To UBound(Elements)'Add current elementSoFar.Add Elements(i)dCompare = dCompare + Elements(i)If Abs(Goal - dCompare) < (0.001 + Tolerance) Then'Goal achievedk = 0ReDim vResult(0 To SoFar.Count - 1, 0)For Each vDummy In SoFarvResult(k, 0) = vDummyk = k + 1NextCombinations = vResultExit ForElseIf dCompare < (Goal + 0.001 + Tolerance) Then'Enough room for another element'Call recursively starting with next higher amountvResult = Combinations(Elements, Goal, Tolerance, SoFar, i + 1)If IsArray(vResult) ThenCombinations = vResultExit ForElseSoFar.Remove SoFar.CountdCompare = dCompare - Elements(i)End IfElse'Amount too highSoFar.Remove SoFar.CountExit ForEnd IfNext 'Try next higher amountEnd Function