How to Apply Payments to Aged Receivables Automatically using Excel VBA

[hhap]

I am new here. I have attached an excel file of the problem. I have several rows representing customers who owe (receivables). These receivables have been aged into 0 - 30 , 31 - 45, 46 - 90, 91 - 180 , 181+ ; The cumulative balance appears under the column named " Balance Due". The debts or receivable amounts are in positive . When the customers make payments (negative in the attached file) our system is supposed to automatically apply it to reduce reduce the oldest aged debts before applying to the recent debts. Unfortunately the system we are using is not able to do that. As result we do that manually in Excel. This is very tedious since there are about 1500 rows. I will be grateful if I can get an excel vba that can be ran to do this automatically.

[DocAElstein]

Hello hhap
Welcome to ExcelFox

I think I understand only understand partially or approximately what you want, and I don’t know anything about your Excel VBA abilities. So I will initially give you some simple example coding


Take a look at this simple example in your returned workbook
https://i.postimg.cc/QN6QwQXv/Peter-Pays-200-Euros.jpg
Peter Pays 200 Euros.jpg
upload picture

In this example, Peter Pays Payment Paying 200

Here is that range again before anything is done
_____ Workbook: Copy of Receivable Ageing Example for VBA.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	F	G	H	I	J	K
17	Customer Name		Balance Due	0 - 30	31 - 45	46 - 90	91 - 180	181+		Payment
18	Peter		580	50	200	300	20	10		200

Worksheet: Aging Summary

Now we run the macro below, and the debts are reduced working from the right

_____ Workbook: Copy of Receivable Ageing Example for VBA.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	F	G	H	I	J	K
17	Customer Name		Balance Due	0 - 30	31 - 45	46 - 90	91 - 180	181+		Payment
18	Peter		380	50	200	130	0	0		0

Worksheet: Aging Summary

Option Explicit
' I have several rows representing customers who owe (receivables). These receivables have been aged into 0 - 30 , 31 - 45, 46 - 90, 91 - 180 , 181+ ; The cumulative balance appears under the column named " Balance Due". The debts or receivable amounts are in positive . When the customers make payments (negative in the attached file) our system is supposed to automatically apply it to reduce reduce the oldest aged debts before applying to the recent debts. Unfortunately the system we are using is not able to do that. As result we do that manually in Excel. This is very tedious since there are about 1500 rows.
Sub ReduceDebtStartingFromRight() ' https://www.excelfox.com/forum/showthread.php/2953-How-to-Apply-Payments-to-Aged-Receivables-Automatically-using-Excel-VBA?p=23995#post23995
Dim RngPeter As Range
 Set RngPeter = Range("E18:I18")
Dim ClmDebt As Long, Clm As Long
     For Clm = 9 To 5 Step -1 ' ======= Looping columns  9 8 7 6 5 (I H G F E ) ================
      Let ClmDebt = Cells(18, Clm).Value
        If ClmDebt <> 0 Then
            If ClmDebt = Range("K18").Value Then Let Cells(18, Clm).Value = 0: Let Range("K18").Value = 0: Exit For                                            ' we have used up all payment so we are finished
            If ClmDebt > Range("K18").Value Then Let Cells(18, Clm).Value = Cells(18, Clm).Value - Range("K18").Value: Let Range("K18").Value = 0: Exit For    ' we have used up all payment so we are finished
        ' If we get this far, then the payment is more than the column debt.
         Let Range("K18").Value = Range("K18").Value - Cells(18, Clm).Value    ' Reduce the payment by the amount needed to remove debt for this column
         Let Cells(18, Clm).Value = 0                                          ' We no longer have any debt for this column
        Else
        ' Column Debt is 0 so we do nothing at this column
        End If
     Next Clm ' ================================================================================
End Sub

Alan

[hhap]

Receivable Ageing Example for VBA.jpg

Thank you DocAElstein for the code. Very sorry for responding late to your replay . I was a bit under the weather. Basically the image shown is the manual solution to my request. The figures in bracket (in red fonts ) are payments which have not been applied to the debts yet. When they are applied starting from the right (e.g 181+) , the payments are removed . The figures under the balance due column stay the same since it is a summation of all the aged balances including the payments in bracket.

[DocAElstein]

Hi,

I was a bit under the weather.

There is lots of things to feel under the weather about everywhere currently, chin up, .
Life’s a piece of Shit, when ya look at it, so Always look on the bright side of life

There are not so many people passing here anyway, and the Email notifications rarely work, so fast responses are not the norm here…

---

OK, your last post makes it a lot clearer to me. I think now I either understand fully or I am close

I will do a simpler coding for you that will work on a single row. If you need help in adapting that to a final coding to suit you better, then let me know.
The coding is similar to my first attempt for you
( Note it is also easy to adapt the coding to run automatically when any entry is made )

---

Here is the next coding for you

Sub ReduceDebtStartingFromRight2() ' https://www.excelfox.com/forum/showthread.php/2953-How-to-Apply-Payments-to-Aged-Receivables-Automatically-using-Excel-VBA?p=24007&viewfull=1#post24007
Dim RngSelect As Range, SelRow As Long, Ws As Worksheet
 Set Ws = Selection.Parent   ' The  Parent  will get the correct worksheet.
 Let SelRow = Selection.Row
 Set RngSelect = Ws.Range("E" & SelRow & ":I" & SelRow & "")               '   We know the columns, and the row will be that of the selected row

Dim TPNA As Double ' This will be the  Total Payments Not Applied  something like SUMIF(E4:I4,"<0",E4:I4)
 Let TPNA = -1 * Ws.Range("K" & SelRow & "").Value                      ' Let TPNA = Ws.Evaluate("SUMIF(" & RngSelect.Address & ",""<0""," & RngSelect.Address & ")")

Dim ClmDebt As Long, Clm As Long
     For Clm = 9 To 5 Step -1 ' ======= Looping columns  9 8 7 6 5 (I H G F E ) ================
      Let ClmDebt = Ws.Cells(SelRow, Clm).Value
        If ClmDebt > 0 Then    ' this will allow empty columns or -ve columns to be ignorred
            If ClmDebt = TPNA Then Let Ws.Cells(SelRow, Clm).Value = "":  Exit For                                             ' we have used up all payment so we are finished
            If ClmDebt > TPNA Then Let Ws.Cells(SelRow, Clm).Value = Ws.Cells(SelRow, Clm).Value - TPNA:  Exit For    ' we have used up all payment so we are finished
        ' If we get this far, then the payment is more than the column debt.
         Let TPNA = TPNA - Ws.Cells(SelRow, Clm).Value
         Let Ws.Cells(SelRow, Clm).Value = ""    ' All debt in this column is removed
        Else
        ' Column Debt is 0 or -ve so we do nothing at this column
        End If
      
     Next Clm ' ================================================================================
    
'  Empty negative values
    For Clm = 5 To 9 Step 1
        If Ws.Cells(SelRow, Clm).Value < 0 Then Let Ws.Cells(SelRow, Clm).Value = ""
    Next Clm
End Sub

To test this, select any cell in a row. Any cell will do. For example, select CharlesP, ( in worksheet Aging Summary 2 in the returned File attached to this post
https://postimg.cc/1gmtBHvm
Select CharlesP in Worksheet Aging Summary 2.JPG

This is what the row looks like initially
_____ Workbook: Copy of Receivable Ageing Example for VBA 2.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	F	G	H	I	J	K
6	CharlesP	GA-00020	5,875,488.00	-2,037,344.35	6,547,617.32	1,485,671.86	-706,127.37	585,670.54		-2,743,471.72

Worksheet: Aging Summary 2

Now run the macro, Sub ReduceDebtStartingFromRight2()

That should change the worksheet to look like this
_____ Workbook: Copy of Receivable Ageing Example for VBA 2.xls ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	F	G	H	I	J	K
6	CharlesP	GA-00020	5,875,488.00		5,875,488.00					0.00

Worksheet: Aging Summary 2


See how you get on with that

Alan

[p45cal]

DocElstein, I think the negative numbers in the grid represent the overpayment of the debt in that column. I'm guessing that an amount has been paid off, destined for a specific age of the debt and that amount was more than necessary to pay off that part and what we see is the overpayment part only. Consequently I think those values need to be made 0, but the amount of overpayment needs to be distributed among the remaining aged debts, starting with the oldest.

I've written a small bit of vba code for the OP to confirm it's right, before I refine it.
It's the blah macro. It creates a copy of the worksheet and works on that.
At the moment it produces the same results as the manual solution.

Comments in the code.

[hhap]

DocElstein, I think the negative numbers in the grid represent the overpayment of the debt in that column. I'm guessing that an amount has been paid off, destined for a specific age of the debt and that amount was more than necessary to pay off that part and what we see is the overpayment part only. Consequently I think those values need to be made 0, but the amount of overpayment needs to be distributed among the remaining aged debts, starting with the oldest.

I've written a small bit of vba code for the OP to confirm it's right, before I refine it.
It's the blah macro. It creates a copy of the worksheet and works on that.
At the moment it produces the same results as the manual solution.

Comments in the code.

I think DocElstein code removes the negative numbers after it has applied the payments to the remaining aged debts starting with the oldest. As you stated your approach will give the same result as the manual. During payment by customers, the cashier is supposed to manually distribute the payment to the aged debts starting with the oldest. However the customers are a lot so she just post it as a credit for the customer and therefore the payment is not applied to the aged debts at all.

[hhap]

....
OK, your last post makes it a lot clearer to me. I think now I either understand fully or I am close

I will do a simpler coding for you that will work on a single row. If you need help in adapting that to a final coding to suit you better, then let me know.
The coding is similar to my first attempt for you

Dear Alan, I have tested the updated vba/macro on one row and it worked . I am most grateful for your assistance . I will adapt it to cover all the rows . Thank you.

[DocAElstein]

Dear Alan, I have tested the updated vba/macro on one row and it worked . I am most grateful for your assistance . I will adapt it to cover all the rows . Thank you.

That’s great. If you need help with adapting, then come back.
And thanks for the feedback and for further clarifying it for us. That’s always helpful.

Just a couple of notes:
_ My coding assumes the credit ( the sum of all red number ) in a row, will not be more than the total debt. In other words, I have not considered the case of if total payments in a row are more than the total debts in a row. But I think I could probably modify it to allow for that, if you want that.
_ My coding is the simplest sort. It will be slow compared to what a more professional solution would be. But it’s easier to understand and modify and debug. But it would still be a lot quicker than doing it manually
_ I think the macro from p45 works, ( and it is already doing it for all rows ). In Excel VBA there is almost an endless amount of different ways to do something like you want. So I think if you have the time, it’s always useful to see and consider different ways. Often it’s a combination of various things, including personal preference, which is finally the best solution for you.

Alan

[DocAElstein]

DocElstein, I think the negative numbers in the grid represent the overpayment of the debt in that column. I'm guessing that an amount has been paid off, destined for a specific age of the debt and that amount was more than necessary to pay off that part and what we see is the overpayment part only. Consequently I think those values need to be made 0, but the amount of overpayment needs to be distributed among the remaining aged debts, starting with the oldest.

I've written a small bit of vba code for the OP to confirm it's right, before I refine it.....
.

Hi Pascal
Thanks for the clarification, I think I had finally just about twigged to that, so that was / is my final conclusion, similar to yours, something like this was finally in my head:
At some point all the columns E to I are either empty of black showing debt. Then someone or something comes along and "pays" somehow money into a column which will reduce that debt in that column. ( That is done manually,and according to the last info from hhap,- a Lady does that manually, and If he or it pays too much, she puts the difference in, in –ve, and then the column turns red and – indicating a credit). That is where we come in.
So at that point a VBA code is wanted, – we use the ( total ) credit to reduce as much of the remaining debts in columns E to I that it can, starting from the right.
That seems to be similar what you are saying
I have not considered the case of if the credit is more than the total summed debts from all columns. I think perhaps your code might be allowing for that possibility, at first glance I am not sure what you are doing, but as ever that is me, being slower than everyone else to get the point, Lol. It seems to get the correct results as far as I can tell.

( P.S. we have some similar thoughts, Lol, I always copy the original OP worksheet, and often get in a muddle with the two at some point , I need to think of doing something like you did with a macro always to tidy my workings up a bit)

Alan

[p45cal]

I have not considered the case of if the credit is more than the total summed debts from all columns. I think perhaps your code might be allowing for that possibility

I did consider it and coded something for it but didn't include it in my attachment.
It was one line of code which adds a comment in column L:

  Next clm
  If PaymentToApply > 0 Then Cells(rw.Row, "L").Value = "Unallocated amount: " & PaymentToApply '<<<<<<added line
Next rw