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.
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