Cycle through a list of Investors and calculate the XIRR for each one to automate process

Question

So I have been stuck on this problem for a few days. I have looked at some others codes but I am still coming up short. I am not the best at VBA either.

I have a list of investors with their attached payments and dates. I am trying to run a command button that will go through each Account, find their related payments and dates, run the XIRR function and then place the XIRR value at the bottom to the right of each account. This is simple enough to do by hand but when you have a spreadsheet of 15000 cells+ it becomes tedious and I am trying to automate this process. It becomes difficult because each investor has different payment amounts so to find the correct location to place the XIRR value has also stumped me.

Here is an example of my spreadsheet

Dim i As Integer
Dim x As Double
Dim dateArray() As Date
Dim dateStrings() As String
Dim valArray() As Double
    
   ReDim dateArray(Dates.Count)
   ReDim valArray(Trans.Count)
   ReDim dateStrings(Dates.Count)



'Sheets("InvestorList").PivotTables.GetPivotData("Account", "x") = i
'Sheets("AccountPayments").Find ("i")
End Sub

Public Function MyXIRR(Dates As Range, Trans As Range, Balance As Double)


    For i = 1 To Dates.Count
        dateArray(i - 1) = Dates.Item(i).Value
        Next i
        
    For i = 1 To Trans.Count
        valArray(i - 1) = Trans.Item(i).Value
        Next i
    
    'Set the date on the "Balance" line to one day after the last transaction date
    dateArray(Dates.Count) = DateAdd("d", 1, Dates.Item(Dates.Count))
     valArray(Trans.Count) = -1 * Balance
      
    For i = 0 To Dates.Count
       dateStrings(i) = Format(dateArray(i), "mm/dd/yyyy")
       Next i
          
    MyXIRR = Application.WorksheetFunction.Xirr(valArray, dateStrings)
          

End Function

1) Looks like some part of your code is missing at the top, the End Sub has no match. 2) I think the Xirr function requires dates as date values, not strings, so not sure why you are creating a string array. 3) What function is calling `MyXIRR`? — JohnRC, Jan 06 '22 at 18:13

score 1 · Answer 1 · answered Jan 06 '22 at 18:16

So I counseled with a college and he helped reduce my code to something much simpler and cleaner. I ran this code with data and it worked great. Some spot checking may be needed if an XIRR value doesn't appear right but this helps automate the process.

 Private Sub CommandButton1_Click()
Dim myrow As Integer
Dim startrow As Integer
Dim valuerange As String
Dim daterange As String
Dim investor As String

myrow = 2
startrow = 2
investor = Cells(myrow, 1)
Do Until Cells(myrow, 1) = ""
    If Cells(myrow + 1, 1) <> investor Then
        'We are at the end of the list for the current investor.
        daterange = "R" & startrow & "C2:R" & myrow & "C2"
        valuerange = "R" & startrow & "C3:R" & myrow & "C3"
        Cells(myrow, 4) = "=XIRR(" & valuerange & ", " & daterange & ")"
        startrow = myrow + 1
        investor = Cells(myrow + 1, 1)
    End If
    myrow = myrow + 1
Loop
End Sub

score 0 · Answer 2 · edited Jan 07 '22 at 10:45

I would recommend trying the macro recorder to just record your steps... If you are unsure how to do so, here are the steps!

In Excel:

File
Options
Customize ribbon (left panel)
Choose commands from: (dropbox) select "Main Tabs"
Select developer
Click add>>
Click ok
Click developer tab now on top ribbon
Click record macro (top left corner)
Name macro, set shortcut and description if desired
Do what you want the macro to do.
When you completed it for one investor click stop recording
Click Macros in top left
Select the macro you just made and click edit
Should have a skeleton routine to work into your loop

Cycle through a list of Investors and calculate the XIRR for each one to automate process

2 Answers2