• The first column is the date of transaction with the customer (sorted by increasing date)
• The second column is the amount of receivables from customers (debiting)
• The third column is the number obtained by the customer (credited)
• The fourth column is the second column except the third column
• The fifth column is balanced and receivable after each transaction, column 6 is a note
Calculations only need columns 1 to 4.
Create function
1. Function OldOfDebt (mRange As Range, toDate As Date) As Double
This function returns the age of the receivables by date, by answering the outstanding receivables at the last day of receivables of which days the principle that the collected amount will be paid for the receivables to first, then calculate the number of days by weight of each item for the balance.
The function has two parameters, the first mRange is the calculation area, in the example is A2: D13; second toDate is the date to determine the age (toDate must be greater than the last day of the transaction with the customer), in the picture is C19. For example, the calculation of the age of accounts receivable is 191,000 and is 146.36 days returned in cell E19.
2. Function AvgBalance (mRange As Range, toDate As Date) As Double
This function has the same parameter as the upper function, returning the average receivable balance of customers by the proportion of time. In the figure, the function calculates the average balance returned to cell E21 is 106.791 with mRange is A2: D13 and toDate is December 31, 2005. (You can calculate the loss that this customer occupies with the interest rate function in the interval A2 to A13).
Source code
Public Function OldOfDebt (mRange As Range, toDate As Date) As Double
Dim rDate As Range Cot now
Dim rDebit As Range Cot recorded no
Dim rCredit As Range Cot record co
Dim mPaid As Double Tong compared to skin
Dim mClose As Double So far, right toDate
Dim mAccDebit As Double Debit cong don
Dim thisAmount As Double
Dim thisDate As Double
Dim mRow As Long Bien
Dim i As Long
Dim ret As Double Click on the link
mRow = mRange.Rows.Count
Set rDate = mRange.Range (Cells (1, 1), Cells (mRow, 1))
Set rDebit = mRange.Range (Cells (1, 2), Cells (mRow, 2))
Set rCredit = mRange.Range (Cells (1, 3), Cells (mRow, 3))
mPaid = Application.WorksheetFunction.Sum (rCredit)
mClose = Application.WorksheetFunction.Sum (rDebit) - Application.WorksheetFunction.Sum (rCredit)
For i = 1 To mRow
If rDebit.Cells (i, 1) .Value <> 0 Then
mAccDebit = mAccDebit + rDebit.Cells (i, 1) .Value
If mAccDebit> mPaid Then
thisAmount = Application.WorksheetFunction.Min (mAccDebit - mPaid, rDebit.Cells (i, 1) .Value)
thisDate = rDate.Cells (i, 1) .Value
ret = ret + thisAmount * (toDate - thisDate) / mClose
End If
End If
Next i
OldOfDebt = ret
End Function
Public Function AvgBalance (mRange As Range, toDate As Date) As Double
Dim rDate As Range
Dim rAmount As Range
Dim mRow As Long
Dim mLenght As Long is busy to work right away
Dim i As Long
Dim ret As Double
mRow = mRange.Rows.Count
Set rDate = mRange.Range (Cells (1, 1), Cells (mRow, 1))
Set rAmount = mRange.Range (Cells (1, 4), Cells (mRow, 4))
mLenght = toDate - rDate.Cells (1, 1)
For i = 1 To mRow
ret = ret + rAmount.Cells (i, 1) * (toDate - rDate.Cells (i, 1)) / mLenght
Next i
AvgBalance = ret
End Function
Nguyen Van Thang
Email : thang_via@yahoo.com