Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

XIRR- Reference thread 705-1740838 2

Status
Not open for further replies.

Sanjay_S

IS-IT--Management
Sep 6, 2016
9
IN
I had tried to use the first part of the XIRR code (calling the function from excel) given by MajP in the above thread, but I get an error "Run Time Error 3061 Too Few Parameters. Expected 2, and the debug stops at the line :"Set rs = CurrentDb.OpenRecordset(strSql)".

I have put the table, query and Function Code (in Module 1) discussed in the above thread in the attached database Test_XIRR2.

Can someone help me correct this problem?

Sanjay
 
 http://files.engineering.com/getfile.aspx?folder=b35d86a4-29d0-4fe3-aeb6-b121813e1293&file=Test_XIRR2.accdb
Your query had this
XIRR: AccessXIRR("TblPayees","PaymentValue","PaymentDate","PayeeID",[PayeeID],True,0.2)

But your field names had spaces in them
Payment Value
Payment Date

These parameters are the name of the fields. I would change the table. You should never use spaces in field names or any object names.

If you had to keep the spaces then you would have to do this.
XIRR: AccessXIRR("TblPayees","[Payment Value]","[Payment Date]","PayeeID",[PayeeID],True,0.2)
 
Hi MajP,

You were the one who wrote this code, so thank you for your interest.

I did notice that I would have to do the field parameters in the query to match those in the table.

So I modified the query as : SELECT tblPayees.PayeeID, AccessXIRR("TblPayees","[Payment Value]","[Payment Date]","PayeeID",[PayeeID],True,0.2) AS XIRR FROM tblPayees;

But after that, I now get the error: Run Time error 1004; unable to get the Xirr property of the worksheet function class.

The debug stops on the line: XIRR_Wrapper = Excel.WorksheetFunction.Xirr(Payments, Dates, GuessRate)

Any suggestions on how I can get this to work?

Thanks

Sanjay
 
I believe that the XIRR function is in the analysis toolpack. Is that add-in loaded in your Excel?
If unable to get the excel to work you can try the code I wrote to solve the Internal Rate of Return problem.
You would call it the exact same way, but instead of the AccessXIRR then calling Excel wrapper function it calls the function MyXIRR.
The MyXIRR function uses the Newton method to determine a rate that makes the Net Present Value = 0. I believe this works pretty well, but you will have to do some verification. I tried to replicate some examples on line.

Code:
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
    AccessXIRR = MyXIRR(Payments, Dates, GuessRate)
  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


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

For those not familiar (like me)
Internal rate of return (IRR) is the interest rate at which the net present value of all the cash flows (both positive and negative) from a project or investment equal zero.

Internal rate of return is used to evaluate the attractiveness of a project or investment. If the IRR of a new project exceeds a company’s required rate of return, that project is desirable. If IRR falls below the required rate of return, the project should be rejected.

HOW IT WORKS (EXAMPLE):

The formula for IRR is:
0 = P0 + P1/(1+IRR) + P2/(1+IRR)2 + P3/(1+IRR)3 + . . . +Pn/(1+IRR)n
where P0, P1, . . . Pn equals the cash flows in periods 1, 2, . . . n, respectively; and
IRR equals the project's internal rate of return.

Let's look at an example to illustrate how to use IRR.
Assume Company XYZ must decide whether to purchase a piece of factory equipment for $300,000. The equipment would only last three years, but it is expected to generate $150,000 of additional annual profit during those years. Company XYZ also thinks it can sell the equipment for scrap afterward for about $10,000. Using IRR, Company XYZ can determine whether the equipment purchase is a better use of its cash than its other investment options, which should return about 10%.

Here is how the IRR equation looks in this scenario:
0 = -$300,000 + ($150,000)/(1+.2431) + ($150,000)/(1+.2431)2 + ($150,000)/(1+.2431)3 + $10,000/(1+.2431)4
The investment's IRR is 24.31%, which is the rate that makes the present value of the investment's cash flows equal to zero. From a purely financial standpoint, Company XYZ should purchase the equipment since this generates a 24.31% return for the Company --much higher than the 10% return available from other investments.
A general rule of thumb is that the IRR value cannot be derived analytically. Instead, IRR must be found by using mathematical trial-and-error to derive the appropriate rate. However, most business calculators and spreadsheet programs will automatically perform this function.
[Click here to see How to Calculate IRR Using a Financial Calculator or Microsoft Excel]
IRR can also be used to calculate expected returns on stocks or investments, including the yield to maturity on bonds. IRR calculates the yield on an investment and is thus different than net present value (NPV) value of an investment.

 
 http://files.engineering.com/getfile.aspx?folder=3b79aaa1-79ea-4a85-b74d-dd4f3dc7fcc4&file=Access_XIRR.accdb
MajP, Thank you once again for your interest- I did think of trying out your other code for XIRR, and did get a result out of it.

I had to modify the line: "AccessXIRR = MyXIRR(Payments, Dates, GuessRate)" to "AccessXIRR = Format(Round(MyXIRR(Payments, Dates, GuessRate), 4), "Percent")" to get the query to give me an XIRR in xx.xx% format.

Else, it worked like a charm. Thank you again! This problem has bugged me for a while now, and I'm glad we have a solution.

The results compare to the first 4 decimal places for the two test cases I ran.

On Excel- yes, I do have the analysis toolpak added, but the query still returns the same error.

Regards,

Sanjay

 
I can run your database and it works. However if I google this error I learn that XIRR if very sensitive to dates formats and fails on European format (DD/MM/YYYY) so you can pass the dates as string in US format "mm/dd/yyyy". If you do not have us regional settings you can try this fix.

Code:
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
 [b]Dim Dates() As String[/b]
  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
      [b]Dates(I) = Format(rs.Fields(DateField).Value, "mm/dd/yyyy")[/b]
    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 [b]String[/b], 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
 
MajP,

Apologies for the late revert. I tried the method you had suggested, but I still cannot get the excel reference to work.

No matter, as the the other method works just fine. Thank you once again.

A different query though, and kindly excuse my rudimentary VBA knowledge.

In the attached database (Test_XIRR_2_RevV2.accdb), I had run a query with your function on the table XIRR_Array, and it works fine, primarily because I had taken this from another table, through a union of two queries, to produce a complete list of dates and cash flows for each match code.

If I had a different table, XIRR_Array_2, which does not have the terminal value in the CFlow field, or the terminal date in the TDate field, then how would I have to modify your XIRR function to bring those in as the final values?

The Investments are all in the field "[Live Amount]" in Table XIRR_Array_2. The Final Value for each [Match Code] has to be derived by summing the [Market Value] field in this table. One more complication is that the investments are not negative in sign.

Similarly for dates, all the investment dates are in the field [TDate]. The final date has to be set to the last working day of the previous month for which I use the formula:
Code:
IIf(Weekday(DateSerial(Year(Date()),Month([Date()),0))=1,DateSerial(Year(Date()),Month(Date()),0)-2,IIf(Weekday(DateSerial(Year(Date()),Month(Date()),0))=7,DateSerial(Year(Date()),Month(Date()),0)-1,DateSerial(Year(Date()),Month(Date()),0)))
Is this possible at all, or do I have to do the intermediate step of running union queries to get the table in the format required and only then execute the XIRR?

Would be grateful for your insight and assistance.

Sanjay
 
 http://files.engineering.com/getfile.aspx?folder=2e37264c-a0b9-4f24-a830-361c10c90b10&file=Test_XIRR2_RevV2.accdb
In this example
They have investments, withdrawls, and then the final portfolio value.

They show investments as positive and the final portfolio value as negative. But I am guessing you are just reversing the sign and making the investments negative and the final portfolio value positive? I assume it works either way.

If I understand for each "match Code" there should be one more Cash flow added to the query. So for Arka1191 you would have a value of final porfolio value of 502600.85 on the last working day of the month: 7/29/2016.


TDate Live Amount Market Value Match Code
...
7/29/2016 $12,000.00 12227.07 ArkaP1191
7/29/2016 -502,600

So I modified the code. You have to now pass in the name of the field that you have to sum to get the final cashflow (sum of market value)

Code:
Public Function AccessXIRR2(Domain As String, PaymentField As String, DateField As String, PortfolioValueField As String, MatchCode_Field As String, MatchCode_Value As Variant, Optional MatchCode_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 db As DAO.Database
  Dim Dates() As Date
  Dim rsXIRR As DAO.Recordset
  Dim SelectSql As String
  Dim i As Integer
  Dim PortfolioValue As Currency
  Dim FinalDate As Date
If MatchCode_IsText Then MatchCode_Value = "'" & MatchCode_Value & "'"
SelectSql = "SELECT " & PaymentField & ", " & DateField & ", " & PortfolioValueField & " FROM " & Domain & " WHERE " & MatchCode_Field & " = " & MatchCode_Value & " ORDER BY " & DateField
'MsgBox (SelectSql)
Set db = CurrentDb
  Set rsXIRR = db.OpenRecordset(SelectSql)
  'Fill Payments and dates.
  'Debug.Print rsXIRR.RecordCount
  ReDim Payments(rsXIRR.RecordCount)
  ReDim Dates(rsXIRR.RecordCount)
  Do While Not rsXIRR.EOF
    'Sum up the porfolio Value. Could have used a DSUM or a query, but you are looping anyways
    PortfolioValue = PortfolioValue + rsXIRR.Fields(PortfolioValueField)
    Payments(i) = rsXIRR.Fields(PaymentField).Value
    Dates(i) = rsXIRR.Fields(DateField).Value
    i = i + 1
    rsXIRR.MoveNext
  Loop
  Payments(i) = -1 * PortfolioValue
  Dates(i) = GetLastWorkday(Dates(i - 1))
  For i = 0 To rsXIRR.RecordCount - 1
    Debug.Print Payments(i) & " " & Dates(i)
  Next i
    '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
    AccessXIRR2 = Format(Round(MyXIRR(Payments, Dates, GuessRate), 4), "Percent")
  Exit Function
errlbl:
 If Err.Number = 3078 Then
   MsgBox "Can not find your table or query " & vbCrLf & SelectSql
 ElseIf Err.Number = 3061 Then
   MsgBox Err.Number & " " & Err.Description & vbCrLf & "Sql: " & SelectSql
 End If
End Function

The changes are for the payments array and the dates array I have to make the array one item bigger since we will add a record not contained int the table. I added a variable called portfolio value. As I loop the records I sum up the portfolio value.
PortfolioValue = PortfolioValue + rsXIRR.Fields(PortfolioValueField)
I also need to get the last date. I take the last date in the table and pass it to the function

Code:
Dates(i) = GetLastWorkday(Dates(i - 1))

Public Function GetLastWorkday(dtmDate As Date) As Date
  GetLastWorkday = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
  If Weekday(GetLastWorkday) = vbSaturday Then
    GetLastWorkday = GetLastWorkday - 1
  ElseIf Weekday(GetLastWorkday) = vbSunday Then
    GetLastWorkday = GetLastWorkday - 2
  End If
End Function

I am entering all the investments as positive and the final portfolio value as negative. (I assume you could switch that). I get values of this stored in my two arrays. The last line is the sum of the market value on the last day of the month
Code:
18000   2/8/2016
18000   2/15/2016
18000   2/22/2016
18000   2/29/2016
18000   3/8/2016
6000   3/14/2016
12000   3/15/2016
6000   3/21/2016
12000   3/22/2016
6000   3/28/2016
12000   3/29/2016
6000   4/4/2016
12000   4/8/2016
6000   4/11/2016
18000   4/18/2016
12000   4/22/2016
6000   4/25/2016
12000   4/29/2016
6000   5/2/2016
18000   5/9/2016
18000   5/16/2016
18000   5/23/2016
18000   5/30/2016
6000   6/6/2016
12000   6/8/2016
6000   6/13/2016
12000   6/15/2016
6000   6/20/2016
12000   6/22/2016
6000   6/27/2016
12000   6/29/2016
6000   7/4/2016
12000   7/8/2016
6000   7/11/2016
12000   7/15/2016
6000   7/18/2016
12000   7/22/2016
6000   7/25/2016
12000   7/29/2016
-502600.85   7/29/2016
For this get an IRR of 76%. Can that be correct? Seems to high of a value.
 
MajP,

Thanks a million for the help! 76% sounds about right for the data that we have.

Let me try and use the new code on the actual database and report back to you on the speed and accuracy. I hope to do this by tomorrow.

Sanjay

 
MajP,

Checked out the revised code, and modified the last date to function CurrentMonth(), which is the formula I had given in my previous post...i.e., considering we are in Sept, the last date has to be the last working date in Aug, not July, which is what your date(i-1) function gives.

The XIRR for the first match code, ArkaP1191 comes out correctly; but the one for the second match code, ArkaPEDIRD shows -6.23%, whereas it should be +7.67%.

I have attached the database again here, marking it V3 to distinguish it from the previous one.

Could you please check and tell me what is going wrong here?

Sanjay
 
 http://files.engineering.com/getfile.aspx?folder=2782f90e-e235-4e24-8594-3af9444ef532&file=Test_XIRR2_RevV3.accdb
MajP,

Please ignore earlier message- figured out the problem.

All cash flows in the [Live Amount] field cannot have the same sign- some are inflows, and some outflows.

I need to build in a separate cash flow field to handle that, and then,I think the function will work fine.

Thanks a million once again. It has been a pleasure to interact with you.

Regards,

Sanjay
 
Checked out the revised code, and modified the last date to function CurrentMonth(), which is the formula I had given in my previous post...i.e., considering we are in Sept, the last date has to be the last working date in Aug, not July, which is what your date(i-1) function gives
That was a logic error. I was under the impression is was the last working date of the last month in the records, not the last month from today. The function is simply modified
Code:
Public Function GetLastWorkday(dtmDate As Date) As Date
  GetLastWorkday = DateSerial(Year(dtmDate), [b]Month(dtmDate[/b]), 0)
  If Weekday(GetLastWorkday) = vbSaturday Then
    GetLastWorkday = GetLastWorkday - 1
  ElseIf Weekday(GetLastWorkday) = vbSunday Then
    GetLastWorkday = GetLastWorkday - 2
  End If
End Function

And when you call it you simply pass in todays date.

From that link
Inflows are positive, outflows are negative, and the current value is also negative. I have the formula set up that way. But I do not think it matters. I have seen it the other way with deposits as negative, but then you need to modify the code so that it does not make the current value negative. Just do not multiply the portfolio value by -1.

One big thing for performance. Do not make a query like I did originally:
Code:
SELECT DISTINCT [Match Code], 
AccessXIRR2("XIRR_Array_2","[Live Amount]","TDate","[Market Value]","[Match Code]",[Match Code],True,0.1) AS CAGR
FROM XIRR_Array_2;
The problem it first calculates the function for each record in the query and then does a distinct. So if there is a 100 records, it runs the function a 100 times.

Instead build a simple query that just returns the distinct "Match Code". In your case 2 records. Use that query instead.
Code:
SELECT DISTINCT [Match Code], 
AccessXIRR2("XIRR_Array_2","[Live Amount]","TDate","[Market Value]","[Match Code]",[Match Code],True,0.1) AS CAGR
FROM QryDistinctMatchCodes;

Please provide any feedback. I am not really familiar with financial matters, and do not really understand how these calculations are used. I built it from looking at the formula and was told it was solved using Newton's method. I tested it using examples I found on the web, but unfortunately there are cashflows where this will not work and the algorithm will not find an answer. If you can find ones that do not solve or give incorrect answers, I would like to see them and see if I can improve my algorithm. There seems to be certain methods where you can use Newton's but if it does not solve switch to a bisection method.
 
MajP,

Apologies for the delay in posting this. I have worked with your XIRR module across a few months, and have validated the workings compared with the earlier excel model I was using. It is accurate down to 0.1%.

Also, saw your last post above just last week, and the tip there enabled me to dramatically raise the performance of queries containing the XIRR formula, thanks to setting up separate "DISTINCT MATCH CODE" queries.

So thank you once again. Will keep working with this, and planning to start reports with this in the coming month.

If you would like any specific feedback from me on the working or usage of these reports, please do let me know.

With warm regards,

Sanjay
 
The XIRR is a solution to a polynomial and thus potentially has numerous positive and negative real roots depending on the number of sign changes. The challenge is to find the additional roots and determine which roots are viable. Currently the solution will find the first positive root. I cannot guarantee that this is the correct solution. Without trying this on a lot of real data, I am not sure how often it returns the incorrect root. I read up on this and the theory is pretty complicated. You may get multiple rational roots and determining which one is logical is not trivial. I would be interested in any streams that do not return a solution or a solution that is incorrect. The code could then be improved to identify potential problems. I would think that you could add additional data about the cash stream to help determine if the return solution is viable. See attached document.
 
 http://files.engineering.com/getfile.aspx?folder=d7717167-ccbc-4241-ada7-639e3546852d&file=irr-soln.pdf
MajP,

So far no incorrect solutions or no solutions, where the cash flows are with the right signs. I am also checking this frequently against excel workings, and will bring any anomalies to your notice.

Thank you once again for the excellent and committed assist in solving this problem.

Sanjay
 
I have been trying to solve the problem with the query for few days.
This is way over my head......

[qryXIRRCalculation]

SELECT qryXIRRUnion.FundName, AccessXIRR("qryXIRRUnion","Amount","XIRRDate","FundName",[FundName],True,0.2) AS XIRR
FROM qryXIRRUnion
GROUP BY qryXIRRUnion.FundName, AccessXIRR("qryXIRRUnion","Amount","XIRRDate","FundName",[FundName],True,0.2);

[qryXIRRUnion]

SELECT tblFundProfile.FundName as FundName, tblCashFlow.NoticeDate as XIRRDate, tblCashFlow.NetCashFlow as Amount
FROM tblFundProfile INNER JOIN tblCashFlow ON tblFundProfile.IDFundProfile = tblCashFlow.IDFundProfile
WHERE (((tblCashFlow.NoticeDate)<=[Forms]![frmXIRR]![txtDate]));
UNION SELECT tblFundProfile.FundName, tblValuation.ValuationDate as XIRRDate, tblValuation.NetAssetValue as Amount
FROM tblFundProfile INNER JOIN tblValuation ON tblFundProfile.IDFundProfile = tblValuation.IDFundProfile
WHERE (((tblValuation.ValuationDate)=[Forms]![frmXIRR]![txtDate]));


When I run the qryXIRRUnion, it gives me the expected result without any problem. But, When I run the qryXIRRCalculation, 3061 error pops up.

But, when I change the [Forms]![frmXIRR]![txtDate] to actual date (i.e.06/30/2017), both qryXIRRUnion and qryXIRRCalculation are running swimmingly.

Since qryXIRRUnion is working ok with form referencing [Forms]![frmXIRR]![txtDate], I guess the issue here is related to AccessXIRR code.

Can anyone see whats missing here and help me correct?
 
The error is unlikely to be in the code since it is an Access error and not a vba error. What you describe makes it seem like your sql is correct, but the query engine is still choking on it. For a test, I would take you qryXIRRUnion and use it in a make table query. Then build a qryXIRRcalculation using that table. Report back if and where it fails. The fact that you can use a literal and it works makes it seem as if the query engine is having problems resolving the query.
 
This works great and !! I never thought access query engine will cause the problem....Access is not perfect :(
I don't know how to make table query for Union query. So I made another query of Union query. Again thanks, you made my week.
 
I never thought access query engine will cause the problem....Access is not perfect :(
Although the query is not very complex it is doing a lot of non-traditional SQL. It has to read from a Form and then run vba code all from the queries. So you are mixing SQL, VBA, and Access objects. You did a good job of debugging by putting in a literal date value. Would had no idea if not.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top