I need to perform an optimization in VBA. I would like to get it as a part of a function. How can I do it?
This is my function:
Function TirNoPer360(Cash, Dates As Range)
Dim i, n As Integer
Dim sum, rate, tolerance As Double
Dim Inicio As Date
Dim rate as Variant
tolerance = 0.00001
Initial = Dates(1, 1)
sum = 0
For i = 1 To Cash.Rows.Count
sum = sum + Cash(i) / ((1 + rate) ^ (Application.WorksheetFunction.Days360(Initial, Dates(i)) / 360))
Next i
TirNoPer360 = sum
End Function
I´d like to get the value of rate (using root finding algo) thats makes TirNoPer360 = 0.
How can I do it as part of this function? Any guidance would be hepful
Related
I have an Excel spreadsheet that shows deposits to a bank account, plus periodically I check the balance and put that in the spreadsheet. I'd like to make a macro that calculates the to-date equivalent return (i.e., if I have this sequence of deposits, and then the account balance is $X, then the equivalent rate of interest is Y%). For example, I might have:
1-Jan-2010 $100
22-Apr-2011 $200
14-Feb-2012 $310
28-Aug-2013 $500
9-May-2014 $790 # account lost value!
I can get the dates and deposits into a function (along with the ending balance) but I can't get XIRR to work right. I know this is ugly VBA (not a language I know) but here's what I have:
Public Function MyXIRR(Dates As Range, Trans As Range, Balance As Double)
Dim i As Integer
Dim x As Double
Dim dateArray() As Date
Dim valArray() As Double
ReDim dateArray(Dates.Count + 1)
ReDim valArray(Trans.Count + 1)
For i = 1 To Dates.Count
dateArray(i - 1) = Dates.Item(i)
Next i
For i = 1 To Trans.Count
valArray(i - 1) = Trans.Item(i)
Next i
dateArray(Dates.Count) = DateAdd("d", 1, Dates.Item(Dates.Count))
valArray(Trans.Count) = -1 * Balance
For i = 0 To Dates.Count
dateArray(i) = Format(dateArray(i), "dd/mm/yyyy")
Next i
MsgBox ("Hello")
x = Application.Xirr(valArray, dateArray, 0.01)
MsgBox (x)
' MyXIRR = Dates.Count * 100 + Trans.Count
' MyXIRR = dateArray(6)
MyXIRR = valArray(3)
End Function
(The comments and MsgBox at the end are my various attempts to figure out what's going on; ideally, I'd just have a formula in a cell: =MyXIRR( A2:A6, B2:B6, C6 ) which would return the equivalent interest rate.)
I think what's happening is that when I call Application.Xirr, I'm getting a #VALUE exception (error?) But I don't know how to debug it, examine the arrays passed to Xirr, or figure out what's wrong.
I don't know whether this is The Answer, or whether I've merely swept the problem under a different rug, but I was able to get my function to work reliably by converting the dateArray to an array of Strings, where each String is a parseable date.
Public Function MyXIRR(Dates As Range, Trans As Range, Balance As Double)
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)
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
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, 0.01)
End Function
I've become very interested in creating custom functions in Excel using VBA lately, because custom functions can save tremendous amounts of time. As I a used to Java and not VBA, I'm currently having a little trouble with some operators (such as the lack of += ) and Arrays.
However, my latest function, which is a little more complex than the ones I previously created, doesn't want to work.
The functions goal is to calculate the Shareholder Value, given both a Cash-Inflow and Cash-Outflow as Range, interest rates and the equity ratio.
So what the function is supposed to do is:
Calculate all relevant variables (WACC etc)
Calculate the sum of the discounted Cashflows (In- and Outflow) from the Range-Objecs
Calculate the Shareholder Value with using the previously calculated variables
My Code:
Function SHV(CashInflow As Range, CashOutflow As Range, EKZins As Double, FKZins As Double, EKQuote As Double)
Dim DCIF As Double
Dim DCOF As Double
Dim FKQ As Double
Dim FKZ As Double
Dim FKZF As Double
Dim EKZF As Double
Dim GKZ As Double
Dim GKZF As Double
Dim ER As Double
Dim RV As Double
Dim n As Integer
Dim i As Integer
DCIF = 0
DCOF = 0
FKQ = 1 - EKQuote
FKZF = 1 + FKZins
EKZF = 1 + EKZins
GKZ = (FKQ * FKZins + EKQuote * EKZins) / (FKQ / EKQuote)
GKZF = GKZ + 1
n = CashInflow.Count
For i = 1 To n
DCIF = DCIF + ((CashInflow(CashInflow.Row, i) * GKZF ^ i))
DCOF = DCOF + ((CashOutflow(CashOutflow.Row, i) * FKZF ^ i))
Next i
ER = CashInflow(CashInflow.Row, n) / GKZ
RV = CashOutflow(CashOutflow.Row, n) / FKZ
SHV = (DCIF + ER) - (DCOF + RV)
End Function
I hope somebody will be able to help.
I've written the following simple VBA function to calculate linear progression between two amounts for some amount of intervals and return the progression as an array:
Public Function applyLinear(startAmount As Double, stopAmount As Double, Intervals As Integer)
Dim diff As Double
Dim resultArr() As Double
Dim counter As Integer
diff = stopAmount - startAmount
ReDim resultArr(Intervals, 0)
resultArr(0, 0) = startAmount
For counter = 1 To (Intervals)
resultArr(counter, 0) = resultArr(counter - 1, 0) + diff / Intervals
Next ' counter
counter = 0
applyLinear = resultArr
End Function
Unfortunately, what actually gets outputted to the worksheet depends entirely on how many cells the above formula is called from. (This means that it becomes laughably easy for a user to apply the function incorrectly!)
How can I ensure that the entire array is outputted to the worksheet under all circumstances?
Edit: Or rather, more specifically, how can I get VBA to output the entire array when calling the above UDF from a single cell?
Edit 2: Some more clarification. The function does work as intended if "intervals+1" rows are used when calling it. A problem arises however, if (for example) the user accidentally calls the function from 4 rows when intervals is > 4. In this case only the first four elements of resultArr are outputted to the worksheet, this is an issue because it doesn't represent the full linear progression.
While looking into how to do what I suggested in the comment above, I found some interesting info on the Application.Caller function, which allows you to access the properties of the cell a UDF is entered in. See here: Excel cell from which a Function is called
Here's one way to do this, based on a little bit of further guidance from cpearson [http://www.cpearson.com/excel/returningarraysfromvba.aspx]
Public Function applyLinear(startAmount As Double, stopAmount As Double, Intervals As Integer)
Dim diff As Double
Dim resultArr() As Double
Dim counter As Integer
ReDim resultArr(Intervals, 0)
If Application.Caller.Rows.Count <> Intervals + 1 Then
applyLinear = "ERROR - MUST ENTER THIS FORMULA IN " & Intervals + 1 & " CELLS"
Else
diff = stopAmount - startAmount
resultArr(0, 0) = startAmount
For counter = 1 To (Intervals)
resultArr(counter, 0) = resultArr(counter - 1, 0) + diff / Intervals
TotalityCheck = TotalityCheck + resultArr(counter, 0) 'builds in by the end of the loop the total array value
Next ' counter
applyLinear = resultArr
End If
End Function
Although, now that you have the use of the Application.Caller function, you could perhaps do this a little more simply, by removing the need for the user to enter the number of Intervals - instead, define the number of intervals as the application.caller.rows - 1, as follows:
Public Function applyLinear(startAmount As Double, stopAmount As Double)
Dim diff As Double
Dim resultArr() As Double
Dim counter As Integer
Dim Intervals As Integer
ReDim resultArr(Intervals, 0)
Intervals = Application.Caller.Rows.Count - 1
diff = stopAmount - startAmount
resultArr(0, 0) = startAmount
For counter = 1 To (Intervals)
resultArr(counter, 0) = resultArr(counter - 1, 0) + diff / Intervals
TotalityCheck = TotalityCheck + resultArr(counter, 0) 'builds in by the end of the loop the total array value
Next ' counter
applyLinear = resultArr
End Function
Let's say for each student, I have a note of an exam and I need to calculate the percentile rank... of each question, each group of question and total exam (each student).
Do to that I need, for each question, group of question, and total exam:
1) x = the score (That I have of course)
2) the count of score above x
3) the count of score equal to x
4) the count total of score
Do to that it looks like I need to use sub-select for me, in a T-SQL query. Calculate everything inside a big dataset and use it.
Is there a way to acheive that inside SSRS?
I found that interesting post about the percentile function in SSRS, I will give it a try.
https://www.katieandemil.com/ssrs-percentile-function-2008-r2-calculation-custom-code-example?tab=article
I had to create another function to return the rank, but the main idea was there:
Public Shared Dim values As System.Collections.ArrayList
Public Shared Function AddValue(ByVal newValue As Decimal) As Decimal
If (values Is Nothing) Then
values = New System.Collections.ArrayList()
End If
values.Add(newValue)
AddValue = values.Count
End Function
Public Shared Function GetRankPercentile(ByVal CurrentValue As Decimal) As Decimal
Dim countTotal As Integer = values.Count 'nombre total de données
Dim countGreater As Integer = 0
Dim countEqual As Integer = 0
Dim iLoop As Integer
Dim tmpArray as system.array
tmpArray = values.ToArray()
For iLoop = LBound(tmpArray) To UBound(tmpArray)
If tmpArray(iLoop) CurrentValue Then countGreater = countGreater + 1
If tmpArray(iLoop) = CurrentValue Then countEqual = countEqual + 1
Next
GetRankPercentile = Math.Ceiling((countGreater + (countEqual / 2)) / countTotal * 5)
End Function
This question has already been asked for the C++ language but I need a function for VBA. I tried converting the C++ function to VBA, but it doesn't return the right values.
I need a function that does the following:
RoundUp(23.90, 5)
'return 25
RoundUp(23.90, 10)
'return 30
RoundUp(23.90, 20)
'return 40
RoundUp(23.90, 50)
'return 50
RoundUp(102.50, 5)
'return 105
RoundUp(102.50, 20)
'return 120
Here's what I have so far. It works most of the time, but returns incorrect values for numbers that are less than .5 less than the multiple. So the problem seems to be a rounding problem with how I'm calculating the remainder value.
Public Function RoundUp(dblNumToRound As Double, lMultiple As Long) As Double
Dim rmndr As Long
rmndr = dblNumToRound Mod lMultiple
If rmndr = 0 Then
RoundUp = dblNumToRound
Else
RoundUp = Round(dblNumToRound) + lMultiple - rmndr
End If
End Function
For Example:
RoundUp(49.50, 50)
'Returns 49.50 because rmndr = 0
I'd simply divide by the lMultiple, round up and multiply again.
Assuming you indeed always want to round up (also for negative numbers):
Public Function RoundUp(dblNumToRound As Double, lMultiple As Long) As Double
Dim asDec as Variant
Dim rounded as Variant
asDec = CDec(dblNumToRound)/lMultiple
rounded = Int(asDec)
If rounded <> asDec Then
rounded = rounded + 1
End If
RoundUp = rounded * lMultiple
End Function
I'm not actually a VBA programmer, so this might need a tweaked comma or two. However the important thing is:
Use Decimal (variant subtype) for precision
Let VB do the math for you
Worth trying WorksheetFunction.Ceiling method (Excel)
WorksheetFunction.Ceiling(27.4,5)
Above example will return 30. Here is Link:
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.ceiling
A far simpler solution is to add .5 to the number before rounding:
1.1 -> Round(1.1+.5, 0) -> 2