Reputation: 11
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
Upvotes: 0
Views: 230
Reputation: 51
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:
Upvotes: 0
Reputation: 11
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
Upvotes: 1