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.
Related
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
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'm trying to teach myself VBA writing some little things. I'm trying to make something that allows you to select some data and then calculates the mean and variance. My code is as follows :
Sub VarianceCalculator()
Dim k As Integer
Dim SelectedData As Range
Dim SelectedDataArray() As Variant
Dim Var As Double
Dim Mu As Double
On Error Resume Next
Set SelectedData = Application.InputBox("Select a range of data to be
calculated", Default:=Selection.Address, Type:=8)
On Error GoTo 0
SelectedDataArray = Range(SelectedData.Address)
k = UBound(SelectedDataArray)
Call VarianceCalculatorWithArray(SelectedDataArray, k)
MsgBox ("The selected data has variance " & Var & " and has mean " & Mu)
End Sub
Sub VarianceCalculatorWithArray(Data() As Variant, k As Integer)
Dim Var As Double
Dim Mu As Double
Dim j As Integer
Dim i As Integer
ReDim Data(k) As Variant
Mu = 0
Var = 0
For j = 0 To k
Mu = Mu + (Data(j)) / (k + 1)
Next j
For i = 0 To k
Var = Var + ((Data(i) - Mu) ^ (2)) / (k + 1)
Next i
End Sub
I think the error is that somehow the data is not getting transferred into the array but I can't find a solution to this.
Thanks!!
There are two major problems:
(1) If you want to pass the variables Var and Mu from one procedure to another you'll have to declare them as public variables before the first procedure. The alternative is to setup VarianceCalculatorWithArray as a function.
(2) The array Data() is 2D as a range consists of rows and columns. So, if you want to use an element from this array, you'll have to address it as Data(1, 1). Also note, that this range array starts with row 1 and column 1. Therefore your for...next statements should start with 1 and not with 0.
Note, that you can always set a breakpoint in order to check if data is transferred into the array.
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
I was creating a critical value approximator of American style options. I was getting the error "#Value!" only after around 40 loops (kept track with a counter).
After some trial and error I realized it came from the part of the loop calling the BlackScholes pricing function. In theory I want to run through a range of values iteratively for the spot price while keeping the other variables fixed in a Black Scholes European price calculation. After tinkering around I reduced the issue to the fact that after the first loop it was no longer calculating Black Scholes the way it would if I just used the value on that iteration and the value I was getting was just increasing by 1, then crapping out after 40 loops of wrong values for some non obvious reason.
So below I truncated the code to a very simple skeleton which is the essence of my problem. Any help would be appreciated.
Function Looper(S As Double, K As Double, r As Double, t As Double, q As Double, Vol As Double) As Double
Dim i As Double
For i = 100 To 150 Step 1#
MsgBox i
MsgBox BS(i, K, r, t, q, Vol, "Call") 'After the first loop the values are wrong,
'What I'd like is, BS(100,...), BS(101,...),BS(102,...) which it is not.
'Not sure what it's actually calculating, since the values are way off
Next i
End Function
Public Function BS(S As Double, K As Double, r As Double, t As Double, q As Double, Vol As Double, CP As String) As Double
Dim volrootime As Double
Dim d1 As Double
Dim d2 As Double
Dim DiscF As Double
Dim DivF As Double
Dim topline1 As Double
Dim topline2 As Double
Dim topline As Double
Dim Price As Double
t = t / 365
r = r / 100
q = q / 100
DiscF = Exp(-r * t)
DivF = Exp(-q * t)
volrootime = (t ^ 0.5) * Vol
topline1 = Log(S / K)
topline2 = ((r - q) + ((Vol ^ 2) / 2)) * t
topline = topline1 + topline2
d1 = topline / volrootime
d2 = d1 - volrootime
If CP = "Call" Then
' Theta is in terms of Calendar days, changing the denominator to 252 changes it to trading days
Price = (S * DivF * Bign(d1)) - (K * DiscF * Bign(d2))
Else
' Theta is in terms of Calendar days, changing the denominator to 252 changes it to trading days
Price = K * DiscF * Bign(-d2) - S * DivF * Bign(-d1)
End If
BS = Price
End Function
The values of r, t, q change each time the BS function is called. If they must stay constant, you should use ByVal in the BS function declaration like this:
BS(S As Double, K As Double, ByVal r As Double, ByVal t As Double, ByVal q As Double, ...
By default, the parameters are passed by reference and any change in the called function are reflected in the calling function.
By the way, in this example, I wouldn't use messageboxes when debugging but instead use debug.print like this:
Debug.Print "i=" & i & vbTab & "BS=" & BS(i, K, r, t, q, Vol, "Call")
The print is made in the window opened by pressing Ctl + G (Go To).