循环浏览投资者列表并计算每个投资者的 XIRR 以实现流程自动化

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

Answer 1

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

Answer 2

I would recommend trying the macro recorder. There are many times I have gotten frustrated and tried searching all over for solutions when I could just record my steps... If you are unsure how to do so, here are the steps!

In excel:

1. file
2. options
3. customize ribbon (left panel)
4. choose commands from: (dropbox) select "Main Tabs"
5. Select developer
6. click add>>
7. click ok
8. click developer tab now on top ribbon
9. click record macro (top left corner)
10. Name macro, set shortcut and description if desired
11. Do what you want the macro to do.
12. when you completed it for one investor click stop recording
13. click Macros in top left
14. select the macro you just made and click edit
15. Should have a skeleton routine to work into your loop

Hope this helps: Happy coding :)