ACCESS XIRR 1

[Speiro1]

Hi All

I am rather new to access. I am trying to calc the XIRR not the IRR. I have a table in which houses all the amounts and dates necessary for the calculation however I know this calculation does not exist in access. Other posts reference using the excel library to get access to the calculation since it exists in excel, but I don't know how ti do this. I saw some code that appears to be a macro but the amounts and dates were typed into it as values. I want to be able to run this macro against amounts and dates I pull from a table into a query. The code i have found is below. Note I am using access 2010. Thank you in advance for any help!

 

[Speiro1]

Public Sub TestXirr()


Dim objExcel As Excel.Application


Dim p(4) As Double
p(0) = -10000
p(1) = 2750
p(2) = 4250
p(3) = 3250
p(4) = 2750


Dim d(4) As Date
d(0) = #1/1/1998#
d(1) = #3/1/1998#
d(2) = #10/30/1998#
d(3) = #2/15/1999#
d(4) = #4/1/1999#


Set objExcel = New Excel.Application
objExcel.RegisterXLL objExcel.Application.LibraryPath & "\ANALYSIS\ANALYS32.XLL"
Debug.Print objExcel.Run("XIrr", p, d) ' Result: 0.374858599901199
objExcel.Quit
Set objExcel = Nothing


End Sub

 

[MajP]

Public Function XIRR_Wrapper(Payments() As Currency, Dates() As Date, Optional GuessRate As Double = 0.1)
   'Must add a reference to the Xcel library. Use Tools, References, Microsoft Excel XX.X Object Library
   XIRR_Wrapper = Excel.WorksheetFunction.XIRR(Payments, Dates, GuessRate)
End Function

No need to instantiate the xcel application

 

[MajP]

Here a generic function that would allow you to do the XIRR. The assumption is that you have to have a query or table that would have the payment schedule for a group of payess. So you would have a field to identify who, the date of payment, and the payment amount. So your data would look like this.

PayeeID	PaymentValue	PaymentDate
Payee1	($10,000.00)	1/1/1992
Payee1	$2,750.00	3/1/1992
Payee1	$4,250.00	10/30/1992
Payee1	$3,250.00	2/15/1993
Payee1	$2,750.00	4/1/1993
Payee2	($100,000.00)	11/3/2014
Payee2	$40,250.00	1/1/2015
Payee2	$60,250.00	2/2/2015
Payee2	$50,250.00	4/1/2015
Payee2	$60,000.00	7/1/2015

So in order to write a generic function that could be used in a query you would have to pass in a bit of information.
Name of the table or query with the data
Name of the field of Payments
Name of the field for payment date
Name of the field that holds the Payee

Since you need to group on the Payee you need the value for the Payee (I called this the Primary key field, but it would be really a foriegn key)
Since you plan to filter on that field you need to know if that field is text or numeric
Then for the calculation you need to have a starting guess

Here is the function

Public Function AccessXIRR(Domain As String, PaymentField As String, DateField As String, PK_Field As String, PK_Value As Variant, Optional PK_IsText As Boolean = False, Optional GuessRate As Double = 0.1) As Variant
  
  'Assumes you have a table or query with a field for the Payee, the Payment, and the date paid.
  Dim Payments() As Currency
  Dim Dates() As Date
  Dim rs As dao.Recordset
  Dim strSql As String
  Dim I As Integer
  
  If PK_IsText Then PK_Value = "'" & PK_Value & "'"
  strSql = "SELECT " & PaymentField & ", " & DateField & " FROM " & Domain & " WHERE " & PK_Field & " = " & PK_Value & " ORDER BY " & DateField
  'Debug.Print strSql
  Set rs = CurrentDb.OpenRecordset(strSql)
  'Fill Payments and dates.
  ReDim Payments(rs.RecordCount - 1)
  ReDim Dates(rs.RecordCount - 1)
  Do While Not rs.EOF
    Payments(I) = rs.Fields(PaymentField).Value
      Dates(I) = rs.Fields(DateField).Value
    Debug.Print I
    I = I + 1
    rs.MoveNext
  Loop
  For I = 0 To rs.RecordCount - 1
    Debug.Print Payments(I) & " " & Dates(I)
  Next I
  AccessXIRR = XIRR_Wrapper(Payments, Dates, GuessRate)
End Function

Public Function XIRR_Wrapper(Payments() As Currency, Dates() As Date, Optional GuessRate As Double = 0.9)
   'Must add a reference to the Xcel library. Use Tools, References, Microsoft Excel XX.X Object Library
   XIRR_Wrapper = Excel.WorksheetFunction.XIRR(Payments, Dates, GuessRate)
End Function

Here is an example of how you would use this function in a query

SELECT 
 tblPayees.PayeeID, 
 AccessXIRR("TblOne","PaymentValue","PaymentDate","PayeeID",[PayeeID],True,0.2) AS XIRR
FROM tblPayees;

This would provide the output

PayeeID	XIRR
Payee1	0.373362535238266
Payee2	7.36284079551697

 

[MajP]

So if you do not want to use excel you can roll your own XIRR function.
Basically you are trying to find the Rate that makes the Net Present Value for the sum of all payments equal to zero.

http://www.ipcc.ca/files/rate_of_return/XIRR_ROR.pdf

So to do this you can use Newton's Method

http://en.wikipedia.org/wiki/Newton's_method

To use newton's method you need to evaluate the NPV function at a rate and evaluate the derivative of the NPV at that rate.
This is then used to find the next rate. Keep doing that until the value of the NPV for that rate is zero (clost to zero)

From my testing, calling this from inside Access is faster than calling the external excel function.
And now I know more abut internal rates of return then I ever would think.
This gives a good Barnie version

http://www.mathsisfun.com/money/internal-rate-return.html

Public Function MyXIRR(Payments() As Currency, Dates() As Date, Optional GuessRate As Double = 0.1) As Variant
   On Error GoTo errLbl
   Const Tolerance = 0.0001
   'Like the Excel it only searches 100 times. Not sure why 100, but you could change this
   'Based on a faulty guess you can get into a loop where you cannot converge
   Const MaxIterations = 1000
   Dim NPV As Double
   Dim DerivativeOfNPV As Double
   Dim ResultRate As Double
   Dim NewRate As Double
   Dim i As Integer
   'Since we are trying to find the Rate that makes the NPV = 0 we are finding the roots of the equation
   'Since there is no closed form to do this, you can use Newtons method
   'x_(n+1) = x_n - f(x_n)/f'(x_n)
   'Basically you evaluate the function and take the tangent at that point.  Your next x is where the tangent crosses
   'The X axis.  Each time this gets you closer and closer to the real root. Can be shown graphically
   ResultRate = GuessRate
   MyXIRR = "Not Found"
   For i = 1 To MaxIterations
     NPV = NetPresentValue(Payments, Dates, ResultRate)
     DerivativeOfNPV = DerivativeOfNetPresentValue(Payments, Dates, ResultRate)
     NewRate = ResultRate - NPV / DerivativeOfNPV
     ResultRate = NewRate
     'Debug.Print "NPV " & NPV & " NPVprime " & DerivativeOfNPV & " NewRate " & NewRate
     If Abs(NPV) < Tolerance Then
       MyXIRR = NewRate
       'Debug.Print "Solution found in " & i & " iterations"
       Exit Function
     End If
   Next i
   Exit Function
errLbl:
   Debug.Print Err.Number & " " & Err.Description
End Function

Public Function NetPresentValue(Payments() As Currency, Dates() As Date, Rate As Double) As Double
  Dim TimeInvested As Double
  Dim i As Integer
  Dim InitialDate As Date
  InitialDate = Dates(0)
  For i = 0 To UBound(Payments)
    TimeInvested = (Dates(i) - Dates(0)) / 365
    NetPresentValue = NetPresentValue + Payments(i) / ((1 + Rate) ^ TimeInvested)
  Next i
End Function

Public Function DerivativeOfNetPresentValue(Payments() As Currency, Dates() As Date, Rate As Double) As Double
  Dim TimeInvested As Double
  Dim i As Integer
  Dim InitialDate As Date
  Dim NPVprime As Double
  InitialDate = Dates(0)
  'NPV = P/(1+R)^N
  'where P is the payment, R is rate, N is the time invested
  'The derivative with respect to R is
  'DerivateNPV = -NP/(1+R)^(N+1)
  'And the derivative of a sum is the sum of the derivatives
  For i = 0 To UBound(Payments)
    TimeInvested = (Dates(i) - Dates(0)) / 365
    NPVprime = NPVprime - TimeInvested * Payments(i) / ((1 + Rate) ^ (TimeInvested + 1))
  Next i
  DerivativeOfNetPresentValue = NPVprime
End Function

 

[Speiro1]

This worked great. Thank you so much for your help.

 

[Andrzejek]

Speiro1
I see you have been a member of TT for a couple of years now.
It is customary to click on a little pink star next to [blue]“Like this post? Star it”[/blue] link It serves at least two purposes: 1. It is a nice way to say “Thank you for helpful post”, and 2. It shows other people who may be searching for an answer that this post was helpful.


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.