Option Compare Database Function XIRR(aXIRR As Variant, nRate As Double, nPayments As Integer) As Double Dim i As Integer XIRR = 0 ' residual of function For i = 1 To nPayments XIRR = XIRR + aXIRR(i, 2) / (1 + nRate) ^ (aXIRR(i, 1) / 365) Next i End Function Private Sub CommandRunXIRR_Click() Dim dbs As Database Dim rstXIRR As Recordset Dim aXIRR() As Double Dim nPayments As Integer Dim dFirstPayDate As Date Dim i As Integer, j As Integer Dim nRate As Double, nLastRate As Double, nRateStep As Double Dim nXIRR As Double Dim nResidual As Double, nLastResidual As Double Set dbs = CurrentDb Set rstXIRR = dbs.OpenRecordset("TableXIRR", dbOpenDynaset) nPayments = DCount("PayDate", "TableXIRR") ReDim aXIRR(nPayments, 3) dFirstPayDate = DMin("PayDate", "TableXIRR") nRate = 0.1 ' initial guess nRateStep = 0.1 ' arbitrary guess i = 1 With rstXIRR While Not .EOF aXIRR(i, 1) = DateDiff("d", dFirstPayDate, !PayDate) aXIRR(i, 2) = !Payment i = i + 1 .MoveNext Wend End With nResidual = 10 nLastResidual = 1 nLastRate = nRate i = 0 While i < 100 And Abs((nLastResidual - nResidual) / nLastResidual) > 10 ^ -8 nLastResidual = nResidual nResidual = XIRR(aXIRR, nRate, nPayments) nLastRate = nRate If nResidual >= 0 Then nRate = nRate + nRateStep Else nRateStep = nRateStep / 2 nRate = nRate - nRateStep End If i = i + 1 Wend nXIRR = nLastRate Debug.Print "The internal rate of return is "; Format(nXIRR, "#.##%") End Sub
Gain unlimited access to on-demand training courses with an Experts Exchange subscription.Get Access
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.