Hello, I have been using the gre

[NadHen]

Hello,

I have been using the great AccessXIRR function since a while. It has been working perfectly except for one case, for which Excel XIRR returns a value. Do you have any idea why ?
Here are the dates and values:
20.06.2017 -12'500.00
31.03.2018 4'910.91
Excel XIRR retrun -0.66

 

[MajP]

Are you referring to this
thread705-1740838
thread705-1778232

If so, there could be lots of reasons. I do not know how the Excel function really works. I coded the solution by using Newtons method to find the roots of the polynomial. When I wrote the code I had never heard of the XIRR or internal rate of return or what it would be used for. I just read about it and tried to see I I could code it. Still have no idea what it means. I read this

http://www.utstat.utoronto.ca/~alexander/irr-soln.pdf

Learned that just because you get an answer does not mean it is a correct answer, because a polynomial has multiple roots. Also there are cases that are highly unlikely to converge. Newtons method uses an interative approach to refine the answer, but if you miss a root you can end up getting farther and farther away. Other cases, each iteration changes so little that it will take very many steps until it converges. So there are two properties in my function you could manipulate and see if you get a solution.

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

If you want it to search more iterations you can beef up the MaxIterations. Obviously the more iterations the slower the function will run. Or you can lower the precision of tolerance. The tolerance says how close to the root (0) you have to be.

This documents explains how IRR give multiple or no solution. There is a very simple example that gives no solution.

https://medium.com/@johncousins_68418/irr-caveats-62cb23644e97

My code my be lacking. After 1000 iterations and I do not find a solution I just quit. I should probably try a different initial guess. Your initial guess makes a big difference in finding a solution. I could try 2 or three initial guesses and then quit if no solution. If I remember my code will not handle negative rates of return less than 1% within the formula. If I remember you will get a division by zero error, so not sure how the Excel algorithm handles that.

 

[combo]

Excel calculations are ok, annualised return rate in your example is -66.9%.
The duration of investment period in years is 0.778 ((31.03.2018-20.06.2017)/365). After this period you return 33.29% of invested capital.
Calculation with excel XIRR result:
(1-66.9%)^0.778 = 33.29%,
so the same 33.29 returned.
Ms excel XIRR help:

https://support.office.com/en-us/article/xirr-function-de1242ec-6477-445b-b11b-a303ad9adc9d

What do you return from AccessXIRR in your example? With the same data? Can you test with initial rate closer to excel result (GuessRate)?



combo

 

[MajP]

There are two different things here. The first time I wrote the code for Access was simply to allow you to store your data in Access and run the XIRR excel function. So it creates a recordset for a specific cashflow and puts the dates and payments into arrays. Then it simply calls the Excel worksheet function passing in the needed array. What I learned was that the XIRR function needs US date format to work "MM/DD/YYYY". So I was originally failing on other regional settings. So I modified the code to ensure that. This should work since it is nothing but a wrapper for Excel.
thread705-1769399

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
  On Error GoTo errlbl
  '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
  Dim HasInvestment As Boolean
  Dim HasPayment As Boolean
  Dim SumOfPayments
  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
    If IsNumeric(rs.Fields(PaymentField).Value) Then
      Payments(i) = rs.Fields(PaymentField).Value
      If Payments(i) > 0 Then HasPayment = True
      If Payments(i) < 0 Then HasInvestment = True
    Else
      AccessXIRR = "Invalid Payment Value"
      Exit Function
    End If
    If IsDate(rs.Fields(DateField).Value) Then
      Dates(i) = rs.Fields(DateField).Value
    Else
      AccessXIRR = "Invalid Date"
      Exit Function
    End If
    i = i + 1
    rs.MoveNext
  Loop
  If Not HasInvestment Then
    AccessXIRR = "All Positive Cash Flows"
  ElseIf Not HasPayment Then
    AccessXIRR = "All Negative Cash Flows"
  Else
    'Choose which function to calculate XIRR
    'A function to do a binomial search and get a good guess.  Somewhere
    'between one and -1 and 1 where the sign changes.
    GuessRate = GetGoodGuess(Payments, Dates)
    Debug.Print "Guess " & GuessRate & vbCrLf
    
    [b]' CHOOSE FUNCTION TO USE Either Excel Or MajP homegrown
    ' AccessXIRR = MyXIRR(Payments, Dates, GuessRate)
      AccessXIRR = XIRR_Wrapper(Payments, Dates, GuessRate)[/b] 
 End If
  Exit Function
errlbl:
 If Err.Number = 3078 Then
   MsgBox "Can not find your table or query " & vbCrLf & strSql
 ElseIf Err.Number = 3061 Then
   MsgBox Err.Number & " " & Err.Description & vbCrLf & "Sql: " & strSql
 End If
End Function

The Above Function can simply call the wrapper Excel function

Public Function XIRR_Wrapper(Payments() As Currency, Dates() As String, 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

Some people were having a problem with Excel so I wrote MyXIRR function. I gave you the option to either call the XIRR_Wrapper (call to excel) or use my homegrown XIRR function. They are set up the same way so you can choose either My understanding from replies that it worked faster and better in some instances. However, I do not think it handles negative rates of return, but now I think I know why and should be an easy fix.

If you do not want to call the Excel function then you could call this instead. However, if Excel works then you may want to go that route. I have not used this enough to tell where it fails.

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. Rate = " & NewRate & vbCrLf
       Exit Function
     End If
   Next i
   Exit Function
errlbl:
   Debug.Print Err.Number & " " & Err.Description & " NPV " & NPV & " dNPV " & DerivativeOfNPV
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)
  'Debug.Print "NPV rate " & Rate
  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
  'Debug.Print Rate & "Derive NPV rate"
  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

Public Function GetGoodGuess(Payments() As Currency, Dates() As Date) As Double
  Dim TimeInvested As Double
  Dim NPV As Double
  Dim i As Double
  Dim Rate As Double
  Dim InitialDate As Date
  Dim newNPV As Double
  Dim minNPV As Double
  Dim minRate As Double
  Dim UpperRate As Double
  Dim LowerRate As Double
  Dim UpperNPV As Double
  Dim LowerNPV As Double
  Const iterations = 10
  InitialDate = Dates(0)
  
  'check Left end
  LowerRate = -0.999
  LowerNPV = NetPresentValue(Payments, Dates, LowerRate) ' this is NPV associated with lower rate. Should be the larger NPV
  'Check right end
  UpperRate = 0.999
  UpperNPV = NetPresentValue(Payments, Dates, UpperRate)
  'Debug.Print "LowerNPV " & LowerNPV & " UpperNPV " & UpperNPV
 ' Debug.Print "LowerRate " & LowerRate & "UpperRate " & UpperRate
  'If no sign change between the two then the rate is either > .999 or <-.999
  If Not HasSignChange(LowerNPV, UpperNPV) Then
    If Abs(LowerNPV) < Abs(UpperNPV) Then
      Rate = LowerRate
    Else
      Rate = UpperRate
    End If
    GetGoodGuess = Rate
    Exit Function
  End If
  Rate = 0
  
  For i = 1 To iterations 'number binomial searches
     newNPV = NetPresentValue(Payments, Dates, Rate)
     'Debug.Print "UpperRate " & UpperRate & " lowerRate " & LowerRate
     'Debug.Print "New Rate " & Rate
     If HasSignChange(LowerNPV, newNPV) Then
       UpperNPV = newNPV
       UpperRate = Rate
     Else
       LowerNPV = newNPV
       LowerRate = Rate
     End If
     Rate = GetMidRate(LowerRate, UpperRate)
     'Debug.Print " UpperRate " & UpperRate & " lowerRate " & LowerRate & " midRate " & Rate & vbCrLf
  Next i
  GetGoodGuess = Rate
End Function

Public Function GetMidRate(SmallerRate As Double, LargerRate As Double) As Double
  GetMidRate = (LargerRate - SmallerRate) / 2 + SmallerRate
End Function

Public Function HasSignChange(NPV1 As Double, NPV2 As Double) As Boolean
  If (NPV1 > 0 And NPV2 < 0) Or (NPV1 < 0 And NPV2 > 0) Then HasSignChange = True
End Function

 

[MajP]

FYI, on my version code I get a solution for your data. However, the solution is -0.699 no -.66. I did it in Excel and that is the correct number. So do not know what the issue is.

 

[combo]

In my case - a typo, excel calculates -69.9%, that gives reduction to 39.29%, same as input values.

combo

 

[MajP]

After reviewing this, I think my XIRR function handles the negative rates of return OK. I think where it bombs out are rates with a large magnitude over 100%. I think what happens is in the code you do Payments(i) / ((1 + Rate) ^ TimeInvested). Since time is in days and a large number, if the rate is a large number the value gets likely driven to zero. So it just does not move from there for subsequent iterations, thus never converging.
However, not sure if Excel handles those either. I put in a huge investment with little return and it seems it would only return -1 which I am guessing is not a legitimate result. So maybe MyXIRR code is more useable than I thought.