I am trying to create a Vertical Horizontal Filter (VHF) indicator using Excel VBA.
To make things simple, a n-day VHF is calculated as the ratio of the difference between the maximum of n-period highs and the minimum of n-period lows to the sum of past n-period the absolute value of the first difference of the closing prices:
Function VHF(highs As Range, lows As Range, n As Integer, price As Range, price0 As Range)
Dim count As Long
Dim maxhigh As Double
Dim minlow As Double
Dim closediff As Double
Dim day As Integer
maxhigh = Application.Max(highs)
minlow = Application.Min(lows)
day = WorksheetFunction.count(Range(price0, price))
If day >= n Then
For j = 2 To n - 1
closediff = closediff + Abs(price0.Offset(j, 0) - price0.Offset(j - 1, 0))
Next j
VHF = (maxhigh - minlow) / closediff
End If
End Function
There is some problem with my VBA code, hopefully someone can help me with it thanks!
Related
Hope everyone is doing okay and keeping safe
I have been tasked to make a Fund Performance dashboard using VBA
I am able to get stock data from yahoo. Also managed to calcuated monthly returns from daily NAVs.
However I am struggling to calculate Quarterly returns.
Here is the code. Though this works in calculating quarterly returns the issue is it repeats. Here is a picture (practice file cant mention real returns)
It calculates the monthly returns, but for quarterly retuns I only want for actual quarter ends in a financial year in a year. However here is it calculating for every month
If anyone can guide me it can be of great help. Thanks
Sub Button2_Click()
Worksheets("Prac").Activate
Dim old_ As Double
Dim new_ As Double
Dim start_row As Integer
start_row = 4
' Track the number of rows
Dim num_row As Integer
num_row = 0
While (Not (IsEmpty(Cells(start_row + num_row, "G"))) And Not (IsEmpty(Cells(start_row +
num_row, "G"))))
num_row = num_row + 3
Wend
Dim end_row As Integer
end_row = num_row + start_row - 1
' Calculate Rate of Return
Dim m_r_j As Double
Dim m_r_m As Double
For r = start_row To end_row - 3 Step 1
old_ = Cells(r, "G")
new_ = Cells(r + 3, "G")
m_r_j = (new_ - old_) / old_
Cells(r + 3, "M").Value = m_r_j
Next
End Sub
I've got this code to calculate the cumulative geometric average of around 500 values (500 rows, 1 column) but I have tried to double check this and I am not getting the correct geometric average values.
Sub GeoR()
Dim No_Values As Integer
No_Values = 500
Dim Product() As Double
Dim Geo() As Double
Dim r() As Double
ReDim r(No_Values)
ReDim Geo(No_Values)
ReDim Product(No_Values)
For i = 1 To No_Values
r(i) = Range("returns").Cells(i, 1)
Product(i) = Application.Product(1 + r(i))
Geo(i) = (Product(i) ^ (1 / i)) - 1
Range("output").Cells(i, 1) = Geo(i)
Next i
End Sub
Could someone please help correct this code?
why don't you use the worksheetfunction?
Function geo(rng As Range) As Double
geo = Application.WorksheetFunction.GeoMean(rng)
End Function
example to call this
Sub geotest()
Debug.Print geo(ActiveSheet.Range("A1:A500"))
End Sub
I am having trouble getting Variants to subtract. I am pulling data from a spreadsheet and if one cell states a phrase then I need the code to subtract one cell from another. If the cell does not state a phrase then I need it to copy one cell to another. I can get the code to run but nothing happens.
Private Sub CommandButton1_Click()
Dim x As Variant, y As Variant, z As Variant, a As Integer, B As String
'getting values for data
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
B = "Total ISU Days: "
'The the cells are empty then subtract. This is not what I wanted to do but I can't think of extracting strings from variants.
If IsEmpty(Range("D2:D48").Value) = True Then
a = y - z
End If
Range("N2:N48").Value = a
Range("M2:M48").Value = B
End Sub
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
A Variant contains metadata about its subtype. In this case, x, y, and z are all arrays of variants.
a = y - z
The right-hand side of this expression simply cannot be evaluated, because {array1} - {array2} means nothing: operators (arithmetic or logical) work off values, not array of values.
What is a supposed to be? It's declared As Integer, so its value is capped at 32,767 (should probably be a Long). If you mean to add up all the values in y and subtract that total from the sum of all values in z, then you need to be more explicit about how you do that - you could use Application[.WorksheetFunction].Sum to add things up:
sumOfY = Application.Sum(Range("I2:I48"))
sumOfZ = Application.Sum(Range("E2:E48"))
a = sumOfY - sumOfZ
And then...
Range("N2:N48").Value = a
That will put the value of a in every single cell in the N2:N48 range - is that really what you mean to do?
Or maybe you meant to do this instead?
Range("N2:N48").Formula = "=IF(D2="""",I2-E2,0)"
That would make each cell in N2:N48 calculate the difference between I and E for each row where D is empty... and there's not really any need for any VBA code to do this.
Let's simplify a bit the task and say that the idea is to substract the values in Range("C1:C6") from the corresponding values in the left - Range("B1:B6"). Then write the corresponding results in column E:
Of course, this would be done only in case that all values in column A are empty. This is one way to do it:
Sub TestMe()
Dim checkNotEmpty As Boolean: checkNotEmpty = False
Dim substractFrom As Range: Set substractFrom = Worksheets(1).Range("B1:B6")
Dim substractTo As Range: Set substractTo = Worksheets(1).Range("C1:C6")
Dim MyCell As Range
Dim result() As Variant
ReDim result(substractFrom.Cells.Count - 1)
Dim areCellsEmpty As Boolean
For Each MyCell In substractFrom
If Len(MyCell) > 0 Then checkNotEmpty = True
Next
Dim i As Long
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result)
End Sub
The code could be improved further, saving all ranges to an Array, but it works quite ok so far.
The part with the +1 and -1 in the For-loop is needed as a workaround:
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
because the arrays start from index 0, but the Cells in a range start with row 1.
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result) is needed, to write the values of the result array to the column E, without defining the length of the range in E.
Below is a cash flow table for 60 periods.
There is a set of recurring cash flows. Is there a simple way in excel to calculate the NPV for all 60 periods (monthly cashflows) without have to create a table of 60 rows and using the NPV formula?
So the formula for 60 line items would be something like this:
=NPV(PERIODIC RATE, VALUES OF CF 1 - 60) + CF0
But can you shortcut it if you know there are recurring cashflows in excel and not have to enumerate all 60 rows?
Thanks in advance.
There is no built in function that will do this, but we can build our own. This is a UDF(User Defined Function):
Function myNPV(rate As Double, vl As Range, times As Range)
If vl.Cells.Count <> times.Cells.Count Then Exit Function
Dim vlArr() As Variant
Dim timesArr() As Variant
Dim ovlArr() As Double
Dim i&, j&, t&, cnt&
vlArr = vl.Value
timesArr = times.Value
For i = LBound(vlArr, 1) To UBound(vlArr, 1)
If vlArr(i, 1) <> "" Then
t = t + timesArr(i, 1)
End If
Next i
cnt = 1
ReDim ovlArr(1 To t)
For i = LBound(vlArr, 1) To UBound(vlArr, 1)
If vlArr(i, 1) <> "" Then
For j = 1 To timesArr(i, 1)
ovlArr(cnt) = vlArr(i, 1)
cnt = cnt + 1
Next j
End If
Next i
myNPV = Application.WorksheetFunction.NPV(rate, ovlArr)
End Function
In the workbook hit Alt-F11. This will open the VBE.
Go to Insert and insert a module. This will open a new module. Copy and paste the code above.
The you can call it like any other formula:
=myNPV(C20/C19,B3:B17,C3:C17)+B2
This has three criteria: The rate per, amounts range, and corresponding number of times.
You can use an annuity formula
In D1 use =1/($B$7/12)*(1-1/(1+$B$7/12)^C1)*B1*1/(1+$B$7/12)^(SUM($C$1:C1)-12) and copy down
I created a user-defined function to show the degree to which companies are matchable. This function works really well, as long as the range I use as thisRange is less than or close to row 2800. I have a list of 4000 companies and when I try to include those in rows over 2800, the function doesn't work. Can the range only be so big? Is there any way to fix this problem?
Here's the code:
Function bestMatch(company As String, thisRange As Range) As String
Dim min As Double, nextMin As Double
Dim cell As Range
Dim score As Double
Dim best As String, str As String, nextBest As String
min = 99999
nextMin = 99999
For Each cell In thisRange.Cells
str = cell.Value
substr1 = Left(str, 1)
substr2 = Left(company, 1)
score = Leven(company, str)
If score < min And substr1 = substr2 Then
min = score
best = str
ElseIf score = min And substr1 = substr2 Then
min = score
best = str + " && " + best
ElseIf score > min And score <= nextMin And substr1 = substr2 Then
nextMin = score
nextBest = str
min = min
best = best
End If
Next
If min > 15 Then
bestMatch = "No Match Found"
ElseIf min <= 15 Then
bestMatch = "1. " + best + " 2. " + nextBest
End If
End Function
Refer to the web page Excel specifications and limits
The sections of this page include:
Worksheet and workbook specifications and limits
Calculation specifications and limits
Charting specifications and limits
PivotTable and PivotChart report specifications and limits
Shared workbook specifications and limits
I believe a range can be as large as an entire worksheet. A worksheet's size limit is listed as 1,048,576 rows by 16,384 columns.
In the "Calculation specifications and limits" section, the limit of a Selected Range is listed as 2048.
What if you try to dump all the values in an array first
Function bestMatch(company As String, start_cell As Range, int count) As String
Dim vals() as Variant
vals = start_cell.Resize(count,1).Value2
For i=1 to count
substr1 = Left(vals(i,1), 1)
...
Next i
...
End Function
I have tried this with >4000 cells and there is no problem.
There is a limitation of the substring for Range object and it is varying depending on the version of Excel you are using. But from what I remember, I am pretty sure it is less than 4000, whatever version you have.
In order to turn this thing around, you should divide it into some parts and use Union.