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

[bigdan]

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 of A & C). In this case I used round numbers but when there's like 5-10 vendors and amounts which have decimals it gets really messy.

So here's the question. I want to be able to compare one number, say a total of $44K, and paste in a list of 20 or so numbers that this total could be made of; can excel then show me which numbers perfectly add up to this?

If someone could show me this I'd be so grateful as it's one of the most annoying things in my bookkeeping work right now.

 

[NdNoviceHlp]

Hi bigdan. U can trial this code...

Public Function CheckCheques(InCol As String, OutCol As String, InTot As Double) As Boolean
Dim LoopCnt As Double, RowNum As Integer, TotNum As Double, Cnt As Integer, Lastrow As Integer
Dim Arr() As Variant, ArCnt As Integer, LetterArr() As Variant, LetCnt As Integer
'Outputs different combos of data input to produce searched total
'InCol is search data Column
'OutCol is output column. Outputs x3 possible combos (X,Y,Z).
    'Add X 's, Y's or Z's together for different combos
'InTot is total being searched for
With Sheets("Sheet1")
Lastrow = .Range(InCol & .Rows.Count).End(xlUp).Row
.Range(OutCol & "2:" & OutCol & Lastrow).Clear
End With
If Lastrow = 1 Then
Exit Function
End If
LetCnt = 0
ArCnt = 0
LetterArr = Array("X", "Y", "Z")
Randomize

above:
LoopCnt = LoopCnt + 1
'change iterations to suit
If LoopCnt = 1000 Or LetCnt = 3 Then
Exit Function
End If
getnewrow:
RowNum = Int((Lastrow * Rnd) + 1)
If RowNum <> 1 Then
If ArCnt <> 0 Then
For Cnt = LBound(Arr) To UBound(Arr)
If Arr(Cnt) = RowNum Then
GoTo above
End If
Next Cnt
End If
'exclude blank cells
If Sheets("Sheet1").Range(InCol & RowNum) = vbNullString Then
GoTo getnewrow
End If
TotNum = TotNum + CDbl(Sheets("Sheet1").Range(InCol & RowNum))
If TotNum = InTot Then
CheckCheques = True
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum
For Cnt = LBound(Arr) To UBound(Arr) - 1
If Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = vbNullString Then
Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = LetterArr(LetCnt)
Else
Sheets("Sheet1").Range(OutCol & Arr(Cnt)) = Sheets("Sheet1").Range(OutCol & Arr(Cnt)) _
                                             & "," & LetterArr(LetCnt)
End If
Next Cnt

LetCnt = LetCnt + 1
End If
If TotNum < InTot Then
ArCnt = ArCnt + 1
ReDim Preserve Arr(ArCnt)
Arr(ArCnt - 1) = RowNum
Else
ArCnt = 0
ReDim Arr(0)
TotNum = 0
End If
GoTo above
Else
GoTo above
End If
End Function

To operate run this sub...

Sub Tester()
Dim Cnt As Integer
Cnt = 1
Do Until CheckCheques("A", "B", Sheets("Sheet1").Range("C" & 2)) Or Cnt = 100
Cnt = Cnt + 1
Loop
If Cnt < 100 Then
MsgBox "DONE. Iterations: " & Cnt
'clear input
'With Sheets("Sheet1")
'LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'.Range("A2:A" & LastRow).Clear
'End With
Else
MsgBox "NO MATCH"
End If
End Sub

In this sheet1 example, headers in row 1, your data in "A2" to "A"& whatever; desired total in "C2"; possible output combos in "B". HTH. Dave