Multiple invoice values add up to given sum

[Oakwoodbespoke]

Hi

I have a Macro that I found on the web to anaylyze a list of values and tell me which one adds up to a given amount.

While it works with whole number it doesn't work with currency/accountancy where the values are such as £345.26

use =TRANSPOSE(MakeupANUMBER(A2:A10,B2)) in D2 to calc results



I have added the current code below


Public Function MakeupANumber(xNumbers As Range, xCount As Long)
'updateby Extendoffice
Dim arrNumbers() As Long
Dim arrRes() As String
Dim ArrTemp() As Long
Dim xIndex As Long
Dim rg As Range

MakeupANumber = ""

If xNumbers.CountLarge = 0 Then Exit Function
ReDim arrNumbers(xNumbers.CountLarge - 1)

xIndex = 0
For Each rg In xNumbers
If IsNumeric(rg.Value) Then
arrNumbers(xIndex) = CLng(rg.Value)
xIndex = xIndex + 1
End If
Next rg
If xIndex = 0 Then Exit Function

ReDim Preserve arrNumbers(0 To xIndex - 1)
ReDim arrRes(0)

Call Combinations(arrNumbers, xCount, ArrTemp(), arrRes())
ReDim Preserve arrRes(0 To UBound(arrRes) - 1)
MakeupANumber = arrRes
End Function

Private Sub Combinations(Numbers() As Long, Count As Long, ArrTemp() As Long, ByRef arrRes() As String)

Dim currentSum As Long, i As Long, j As Long, k As Long, num As Long, indRes As Long
Dim remainingNumbers() As Long, newCombination() As Long

currentSum = 0
If (Not Not ArrTemp) <> 0 Then
For i = LBound(ArrTemp) To UBound(ArrTemp)
currentSum = currentSum + ArrTemp(i)
Next i
End If

If currentSum = Count Then
indRes = UBound(arrRes)
ReDim Preserve arrRes(0 To indRes + 1)

arrRes(indRes) = ArrTemp(0)
For i = LBound(ArrTemp) + 1 To UBound(ArrTemp)
arrRes(indRes) = arrRes(indRes) & "," & ArrTemp(i)
Next i
End If

If currentSum > Count Then Exit Sub
If (Not Not Numbers) = 0 Then Exit Sub

For i = 0 To UBound(Numbers)
Erase remainingNumbers()
num = Numbers(i)
For j = i + 1 To UBound(Numbers)
If (Not Not remainingNumbers) <> 0 Then
ReDim Preserve remainingNumbers(0 To UBound(remainingNumbers) + 1)
Else
ReDim Preserve remainingNumbers(0 To 0)
End If
remainingNumbers(UBound(remainingNumbers)) = Numbers(j)

Next j
Erase newCombination()

If (Not Not ArrTemp) <> 0 Then
For k = 0 To UBound(ArrTemp)
If (Not Not newCombination) <> 0 Then
ReDim Preserve newCombination(0 To UBound(newCombination) + 1)
Else
ReDim Preserve newCombination(0 To 0)
End If
newCombination(UBound(newCombination)) = ArrTemp(k)

Next k
End If

If (Not Not newCombination) <> 0 Then
ReDim Preserve newCombination(0 To UBound(newCombination) + 1)
Else
ReDim Preserve newCombination(0 To 0)
End If

newCombination(UBound(newCombination)) = num

Combinations remainingNumbers, Count, newCombination, arrRes
Next i

End Sub

 

[NdNoviceHlp]

Hi Oakwoodbespoke. The code at this link does what you want. HTH. Dave

is there a way to compare one number (a total) against a bunch of smaller numbers to see which numbers match?

i have a client that has this really annoying bank. when they pay multiple people on the same day the transactions appear as one lump sum. for example if they pay Vendors A, B, and C on the same day, in the amounts of $100, $200, $300, it might appear as $600. Or it might appear as $400 (the sum...

www.mrexcel.com

 

[Oakwoodbespoke]

Thanks NdNoviceHlp

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave