XIRR in VBA Access

[Weilon Sung]

Hi Guys,

I build my macro according to the thread

http://www.tek-tips.com/viewthread.cfm?qid=1740838

and don't get any results but Errors. I googled since 2 days for some Inputs. At least the Problem can come from some data Settings. I tried all the ways I know but it just didnt work...

my codes below. Just the last row doesn't run and gives me permanent the 1004 msg "Unable to get the Xirr property of the WorksheetFunction class"

For debug I tried
- add libery like Excel 14.0, ATP 2.0 Type
- Change the declaration of the range payments and Dates into variant
- Change the language Settings from german to US to get the correctly Date-Format in VBA

 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

 Dim Payments()
  Dim Dates()
  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
 Set rs = CurrentDb.OpenRecordset(strSql)
  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
controll1 = Excel.Application.Sum(Payments)
controll2 = Excel.Application.WorksheetFunction.XIRR(Payments, Dates)

what else I can do?

 

[combo]

You need an excel instance, named differently than library:

Dim Payments()
  Dim Dates()
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim i As Integer
  Dim xlApp as Excel.Application 

  If PK_IsText Then PK_Value = "'" & PK_Value & "'"
  strSql = "SELECT " & PaymentField & ", " & DateField & " FROM " & Domain & " WHERE " & PK_Field & " = " & PK_Value & " ORDER BY "  & DateField
 Set rs = CurrentDb.OpenRecordset(strSql)
  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
Set xlApp = New Excel.Application
controll1 = xlApp.WorksheetFunction.Sum(Payments)
controll2 = xlApp.WorksheetFunction.XIRR(Payments, Dates)
Set xlApp = Nothing

combo

 

[Weilon Sung]

Hi,

i am back from Tests. @Combo: I tried your way and sadly it doesn´t bring me to result. After that, I tried with manually Inputs and IT WORKS. Furthermore, I noticed it doesn`t make difference in Dates when I write it manually or from code. It is the Payments that makes error... But what is the correctly way to declare the Payments? I tried wieh Currency, Variant, Double... non of them works...

' Dim Payments()
'' Dim datum()
'ReDim Payments(0 To 16)
' ReDim datum(0 To 16)
' Payments(0) = -2.02
' Payments(1) = 3.01
'Payments(0) = -10229057.59
'Payments(1) = 10229057.59
'Payments(2) = -10229057.59
'Payments(3) = -625451.12
'Payments(4) = -2122211.12
'Payments(5) = 2122211.12
'Payments(6) = 154530.47
'Payments(7) = -154530.47
'Payments(8) = 2122211.12
'Payments(9) = 154530.47
'Payments(10) = 155601.66
'Payments(11) = -2593361
'Payments(12) = 2593361
'Payments(13) = -2593361
'Payments(14) = 93361
'Payments(15) = -2593360.99
'Payments(16) = 14121566.45
'
'' datum(0) = #10/28/2015#
'' datum(1) = #10/28/2015#
'' datum(2) = #10/28/2015#
'' datum(3) = #10/28/2015#
'' datum(4) = #1/7/2016#
'' datum(5) = #1/7/2016#
'' datum(6) = #1/7/2016#
'' datum(7) = #1/7/2016#
'' datum(8) = #1/7/2016#
'' datum(9) = #1/7/2016#
'' datum(10) = #1/29/2016#
'' datum(11) = #6/8/2016#
'' datum(12) = #6/8/2016#
'' datum(13) = #6/8/2016#
'' datum(14) = #7/29/2016#
'' datum(15) = #11/2/2016#
'' datum(16) = #12/30/2016#

 

[combo]

What is wrong? For me excel's Sum works with variant [pre]Dim Payments()[/pre], I haven't tested other options.
First check if you have proper values in arrays. What do you get in immediate window for Dates and Payments arrays? #12/30/2016# is not vba date format, try [pre]?date[/pre] in immediate to check.

combo

 

[Weilon Sung]

Hi Combo,

I don't know why, but it works with this date Format. I grap the immediate window for the variables which works:

and i get the correctly result for controll2 = 0,0495...But that Payment Array Comes from stupid typing..In normal way, I will declare the Array as a variant, then it goes:

For me it is the same Array in declaration. But why this one doesnt work?

 

[MajP]

I have written extensive on this and address the date issue. See thread
thread705-1769399
For more detail. The function I created appears to work as well or better than Excel and not as sensitive.

 

[combo]

You have different values in two Payments arrays. BTW, that are "locals" windows.

combo

 

[Weilon Sung]

Hi
I am on work today.

@Combo: Thats what makes matter I think. The first Payment for XIRR must be negative, therefore the code doesn`t work with the automatic. But how comes the Code changes position of my table value?? I just use the pick up method from MajP as like:

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

@MajP: thank you a lot for your idea and code for XIRR from Excel. That saves me 3 days work! But I must use the XIRR Estimation...

 

[Weilon Sung]

Hey guys,

IT WORKS, after I summate the values single day before the code starts. Then I just have per day one value and the ordering works now.

Thank u for your Inputs.

Data Inputs:

 

[Weilon Sung]

a question at least. How can i start the query under a macro, my macro tells me he doesn`t know the VBA-macro?