In my line of work I have often come across the situation where we (the company I work for) have received a payment with no payment details and it is unable to match the payment to any open invoices. When the customer has paid oldest-first or the list of open invoices is single-digit it is very easy to do the matching. However when you have to find five out of 50 invoices, things get trickier.
I identified the problem and search for the web and, as usual, Google has answer for (almost) anything.
I came across a VBA/ Macro-enable Excel solution where you enter number of possible outcomes (1), target value / receipt (2), and list all invoices that should be matched (3) and with a click of a button you get your results.
Example of how to match payment with a list of open invoices – this is extremely helpful for any Credit Controller / Sales Ledger
All you need is a basic knowledge of VBA code or how macros work in Excel:
- Open Excel and save as macro-enabled workbook.
- format the page to your liking (or similar to layout in my example above)
- go to developer tab and create a macro and paste the code (see below)
- create a button and assign the macro
- save the workbook and all done.
Code is below. I cannot remember where I found it but I am grateful to the wonderful person who made it.
Sub startSearch()
'The selection should be a single contiguous range in a single column. _
The first cell indicates the number of solutions wanted. Specify zero for all. _
The 2nd cell is the target value. _
The rest of the cells are the values available for matching. _
The output is in the column adjacent to the one containing the input data.
If Not TypeOf Selection Is Range Then GoTo ErrXIT
If Selection.Areas.Count > 1 Or Selection.Columns.Count > 1 Then GoTo ErrXIT
If Selection.Rows.Count < 3 Then GoTo ErrXIT
Dim TargetVal, Rslt(), InArr(), StartTime As Date, MaxSoln As Integer, _
HaveRandomNegatives As Boolean
StartTime = Now()
MaxSoln = Selection.Cells(1).Value
TargetVal = Selection.Cells(2).Value
InArr = Application.WorksheetFunction.Transpose( _
Selection.Offset(2, 0).Resize(Selection.Rows.Count - 2).Value)
HaveRandomNegatives = checkRandomNegatives(InArr)
If Not HaveRandomNegatives Then
ElseIf MsgBox("At least 1 negative number is present between positive numbers" _
& vbNewLine _
& "It may take a lot longer to search for matches." & vbNewLine _
& "OK to continue else Cancel", vbOKCancel) = vbCancel Then
Exit Sub
End If
ReDim Rslt(0)
recursiveMatch MaxSoln, TargetVal, InArr, HaveRandomNegatives, _
LBound(InArr), 0, 0.00000001, _
Rslt, "", ", "
Rslt(UBound(Rslt)) = Format(Now, "hh:mm:ss")
ReDim Preserve Rslt(UBound(Rslt) + 1)
Rslt(UBound(Rslt)) = Format(StartTime, "hh:mm:ss")
Selection.Offset(0, 1).Resize(ArrLen(Rslt), 1).Value = _
Application.WorksheetFunction.Transpose(Rslt)
Exit Sub
ErrXIT:
MsgBox "Please select cells in a single column before using this macro" & vbNewLine _
& "The selection should be a single contiguous range in a single column." & vbNewLine _
& "The first cell indicates the number of solutions wanted. Specify zero for all." & vbNewLine _
& "The 2nd cell is the target value." & vbNewLine _
& "The rest of the cells are the values available for matching." & vbNewLine _
& "The output is in the column adjacent to the one containing the input data."
End Sub
-
Wise Clips 