In Excel VBA, I have a working function to calculate an Exponentially Weighted Moving Average, following http://www.value-at-risk.net/exponentially-weighted-moving-average-ewma/
I want to convert this function to Access VBA to use with some data I have in Access.
I have data of the form:
BucketDate InterpRate
8/17/2015 5.56992228328638E-03
8/18/2015 5.64693660341032E-03
8/19/2015 5.72395092353427E-03
8/20/2015 5.80096524365821E-03
8/21/2015 5.87797956378215E-03
8/22/2015 5.9549938839061E-03
8/23/2015 6.03200820403004E-03
8/24/2015 6.10902252415399E-03
... ...
for 76 datapoints. The VBA subroutine is as follows:
Function EWMA(InterpRate As Range, Lambda As Double, _
MarkDate As Date, MaturityDate As Date) As Double
Dim vZeros() As Variant
Dim Price1 As Double, Price2 As Double
Dim SumWtdRtn As Double
Dim I As Long
Dim m As Double
Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double
vZeros = InterpRate
m = Month(MaturityDate) - Month(MarkAsOfDate)
For I = 2 To UBound(vZeros, 1)
Price1 = Exp(-vZeros(I - 1, 1) * (m / 12))
Price2 = Exp(-vZeros(I, 1) * (m / 12))
LogRtn = Log(Price1 / Price2)
RtnSQ = LogRtn ^ 2
WT = (1 - Lambda) * Lambda ^ (I - 2)
WtdRtn = WT * RtnSQ
SumWtdRtn = SumWtdRtn + WtdRtn
Next I
EWMA = SumWtdRtn ^ (1 / 2)
End Function
However, I cannot pass InterpRate into an array to use to calculate the exponentially weighted moving average. How can I change this in order to calculate the exponential moving average?
Related
I have a function f(x,y) = e^(x+y) and function in VBA like this:
Function Test(n As Integer, x0 As Double, xk As Double, y0 As Double, yk As Double) As Double()
Dim i As Integer
Dim j As Integer
Dim Tablica() As Double
ReDim Tablica(0 To n, 0 To n)
For i = 0 To n
For j = 0 To n
Tablica(j, i) = Exp(x0 + i * (xk - x0) / n + y0 + j * (yk - y0) / n)
Next j
Next i
Test = Tablica
End Function
Is there any way to rewrite this code to work with any function like f(x,y) = x+y etc.?
I interpret your question as how to make the mathematical function an input parameter to the function test. There is no very good way to do this in VBA, but what you can do is to define the function in the code module and then use Application.Run to invoke the function by name from inside test.
Proof of concept:
Function test(f As String, n As Integer, x0 As Double, xk As Double, y0 As Double, yk As Double) As Double()
Dim i As Long, j As Long
Dim Tablica() As Double
ReDim Tablica(0 To n, 0 To n)
For i = 0 To n
For j = 0 To n
Tablica(j, i) = Application.Run(f, x0 + i * (xk - x0) / n, y0 + j * (yk - y0) / n)
Next j
Next i
test = Tablica
End Function
'used like:
Function g(x As Double, y As Double) As Double
g = x - y
End Function
Sub test2()
Range("A1:D4").Value = test("g", 3, 0, 1, 3, 4)
End Sub
Note that you don't need to name the called function f, so that test can work with multiple functions. Unfortunately, VBA lacks a notion of anonymous functions, so you still need to defined your functions as VBA functions (or write your own parser).
So I'm trying to get some calculations and I was wondering why my macro was giving a different result than the one I was getting when using it on my worksheet so I've tested this:
The code:
Option Explicit
Sub Test()
With ThisWorkbook.Sheets("Programaciones")
Dim Efectivos As Single: Efectivos = .Cells(62, 21) '4.65000009536743
Dim Llamadas As Single: Llamadas = .Cells(65, 21) '12
Dim TMO As Long: TMO = .Cells(66, 21) '398.108567311734
Debug.Print Utilisation(Efectivos, Llamadas, TMO) * Efectivos * 1800 / TMO / Llamadas
Debug.Print Utilisation(.Cells(62, 21), .Cells(65, 21), .Cells(66, 21)) * .Cells(62, 21) * 1800 / .Cells(66, 21) / .Cells(65, 21)
End With
End Sub
Why does this happen? I've tried changing Single to Double variable type and got the same result. I know about the floating numbers in vba, but this is more of a question when they are stored in a variable or not.
Edit: Utilisation is a function from Erlang library which has this code
'-----------------------------------------------------------------------
Public Function Utilisation(Agents As Single, CallsPerHalfAnHour As Single, AHT As Long) As Single
'Copyright © T&C Limited 1996, 1999
'Calculate the utilisation percentage for the given number of agents
' Agents is the number of agents available
' CallsPerHalfAnHour is the number of calls received in one hour period
' AHT (Average handle time) is the call duration including after call work in seconds e.g 180
Dim BirthRate As Single, DeathRate As Single, TrafficRate As Single
Dim Util As Single
On Error GoTo UtilError
BirthRate = CallsPerHalfAnHour
DeathRate = 1800 / AHT
'calculate the traffic intensity
TrafficRate = BirthRate / DeathRate
Util = TrafficRate / Agents
UtilExit:
Utilisation = MinMax(Util, 0, 1)
Exit Function
UtilError:
Util = 0
Resume UtilExit
End Function
'-----------------------------------------------------------------------
Private Function MinMax(val As Single, Min As Single, Max As Single) As Single
'Apply minimum and maximum bounds to a value
MinMax = val
If val < Min Then MinMax = Min
If val > Max Then MinMax = Max
End Function
'-----------------------------------------------------------------------
You Dim TMO As Long and read the value TMO = .Cells(66, 21) which you say is 398.108567311734 in the cell. Since Long can only hold integer numbers (no decimals) the value in TMO will be 398 which is not 398.108567311734.
Therefore you get different results when you calculate with …
TMO which is 398
.Cells(66, 21) which is 398.108567311734
Either declare it as Dim TMO As Double so the variable can take a decimal value, or make sure when using .Cells(66, 21) you convert it into long before cLng(.Cells(66, 21)) to cut off the decimals.
This should give the same result as the variables:
Utilisation(.Cells(62, 21), .Cells(65, 21), .Cells(66, 21)) * cSng(.Cells(62, 21)) * 1800 / cLng(.Cells(66, 21)) / cSng(.Cells(65, 21))
Note that this line
Dim Efectivos As Single: Efectivos = .Cells(62, 21) '4.65000009536743
will actually turn the double precision 4.65000009536743 into a single precision. So the value that is in the variable Efectivos is 4.65 because it is declared as Single and therefore cannot contain a such precise number as 4.65000009536743.
The following table shows how your values change with the type of variable you use:
Another example:
Real Life: 10/3 = 3,33333333333333… 'endlesse amounts of 3
Single: cSng(10/3) = 3,333333 '7 digits of accuracy
Double:cDbl(10/3) = 3,33333333333333 '15 digits of accuracy
I am trying to write a function that calculates the minimum distance of one zip code to the other. The function should take in the longitude and latitude of one zip code, and then a 2-D array with all longitude and latitude info of zip codes. Here is the function I wrote:
Public Function PassArray(Longitude As Double, Latitude As Double, ParamArray varValues() As Variant) As Double
Dim arr() As Variant
Dim x As Long
For x = 1 To UBound(varValues(0), 1)
ReDim Preserve arr(x)
arr(UBound(arr)) = Sqr((Longitude - varValues(0)(x, 1)) ^ 2 + (Latitude - varValues(0)(x, 2)) ^ 2)
Next x
PassArray = WorksheetFunction.Min(arr)
I got #Value! error when I tried to use this function. I checked every step and it seems that the UBound(varValues(0), 1) is causing the problem. When I try UBound(varValues) it returns 0, which I guess it is the first dimension upper bound of the parameter array?
I cannot get why UBound(varValues(0), 1) would not work. I thought it should return my longitude & latitude array's last row number.
Consider #Mathieu Guindon's comment and go along those lines:
Option Explicit
'ASSUMPTION: coordinatesArray is a 2D array with rows in dimension 1 and columns in dimension 2.
Public Function PassArray(longitude As Double, latitude As Double, coordinatesArray As Variant) As Double
Dim rowLowerBound As Long
Dim rowUpperBound As Long
Dim x As Long
'We're looking at coordinatesArray's first dimension (rows).
'Let's consider both the lower and upper bounds, so as to adapt to the
'configuration of coordinatesArray.
rowLowerBound = LBound(coordinatesArray, 1)
rowUpperBound = UBound(coordinatesArray, 1)
'Dim arr upfront; this will be way faster than redimming within the loop.
ReDim arr(rowLowerBound To rowUpperBound) As Double
For x = rowLowerBound To rowUpperBound
'Your calculations go here.
'You can access coordinatesArray elements like so:
'coordinatesArray(x, 1) for row x, column 1, and
'coordinatesArray(x, 2) for row x, column 2.
arr(x) = Sqr((longitude - coordinatesArray(x, 1)) ^ 2 + (latitude - coordinatesArray(x, 2)) ^ 2)
Next x
'Note that Application.WorksheetFunction.Min doesn't seem to care
'whether arr is zero, one or n-based.
PassArray = Application.WorksheetFunction.Min(arr)
End Function
Note that I can't vouch for your distance calculation; might work for cartesian coordinates, but for not for longitude/latitude.
I am trying to implement Haversine formula into excel function. Its looks like this:
Public Function Haversine(Lat1 As Variant, Lon1 As Variant, Lat2 As Variant, Lon2 As Variant)
Dim R As Integer, dlon As Variant, dlat As Variant, Rad1 As Variant
Dim a As Variant, c As Variant, d As Variant, Rad2 As Variant
R = 6371
dlon = Excel.WorksheetFunction.Radians(Lon2 - Lon1)
dlat = Excel.WorksheetFunction.Radians(Lat2 - Lat1)
Rad1 = Excel.WorksheetFunction.Radians(Lat1)
Rad2 = Excel.WorksheetFunction.Radians(Lat2)
a = Sin(dlat / 2) * Sin(dlat / 2) + Cos(Rad1) * Cos(Rad2) * Sin(dlon / 2) * Sin(dlon / 2)
c = 2 * Excel.WorksheetFunction.Atan2(Sqr(a), Sqr(1 - a))
d = R * c
Haversine = d
End Function
But when im testing it I am getting wrong distance... I dont understand why. For coordinates used in this topic : Function to calculate distance between two coordinates shows wrong
I am getting 20013,44 as output. Anyone knows what is wrong here? Cant find my mistake...
Atan2 is defined back to front in Excel compared to JavaScript i.e. Atan2(x,y) rather than Atan2(y,x).
You need to reverse the order of the two arguments:-
c = 2 * Excel.WorksheetFunction.Atan2(Sqr(1 - a), Sqr(a))
See this
So
=haversine(59.3293371,13.4877472,59.3225525,13.4619422)
gives
1.65 km
which is the correct distance as the crow flies.
Great tool! Just underscoring that the result will be in kilometers, so if you want miles multiply the result by 0.62137.
I'm using excel time format "hh:mm:ss.000" and adding 50ms at a time to cells in consecutive rows via VBA:
Dim dblTimestamp As Double
dblTimestamp = Selection.Value ' origin timestamp
' Setup base time increment of 50ms over 20 minutes
For i = 1 To Selection.Rows.Count
Selection.Rows(i).Value2 = dblTimestamp + (2# / (864000# * 4#))
dblTimestamp = dblTimestamp + (2# / (864000# * 4#))
Next i
So you see the origin time below on 5/23/2015 and things start out fine:
5/23/2015 05:30:00.000
05:30:00.050
05:30:00.100
05:30:00.150
05:30:00.200
05:30:00.250
The problem is that the precision/rounding errors start to show up after a couple minutes (~1840 rows):
05:31:32.100
05:31:32.149
05:31:32.199
05:31:32.249
And then after 20 minutes it's more pronounced:
05:49:59.793
05:49:59.843
05:49:59.893
05:49:59.943
05:49:59.993
Can I use some other datatype for my calculations or do I have to brute force and add an extra millisecond every ~1840 rows?
I'd prefer a solution that would also apply when I change the time step to 200ms
This should do the trick. Note that I removed your "selection" reference and am instead using "Now()" as the time stamp and placing values in cells A2 through A20000. Functionally, you could combine all the time helper stuff into a single rounding function, but I designed it the way it is to feel more object oriented and to demonstrate a paradigm that's more adaptable. Hope this helps.
'A type used to store time data
Type TimeHelper
MS As Double
BaseTime As Double
End Type
'Value to use as millisecond
Const MilSec = 1 / 86400000
Sub Test()
Dim t As Double
t = Now()
Dim step As Double
step = 75
Dim TH As TimeHelper
For i = 2 To 200000
t = t + step * MilSec
TH = GetTimeHelper(t)
t = RoundMS(TH, step)
Cells(i, 1).Value2 = t
Next i
End Sub
Function GetTimeHelper(t As Double) As TimeHelper
x = t
'Unrounded Hours
x = (x - Round(x, 0)) * 24
'Unrounded Minutes
x = (x - Round(x, 0)) * 60
'Seconds as Milliseconds
GetTimeHelper.MS = (x - Round(x, 0)) * 60000
'Time rounded down to nearest minute by removing millisecond value
GetTimeHelper.BaseTime = t - (GetTimeHelper.MS * MilSec)
End Function
Function RoundMS(TH As TimeHelper, m As Double)
'Construct a time from basetime and milliseconds
'with milliseconds rounded to nearest multiple of m
RoundMS = TH.BaseTime + (Round(TH.MS / m, 0) * m) * MilSec
End Function
You need to round your date value after you have done the addition. Excel dates are stored as numbers under the hood and time is represented by a decimal. For example, 42249.6282730324 is 02/09/2015 (< to the left of the decimal) 15:04:43.550 (< to the right of the decimal) So you need to round this number. Here is a good post showing how you can do this using the INT, CEILING and MOD functions. http://exceluser.com/formulas/roundtime.htm.
I actually just decided to check the text value after every row to see if it ended in a 9 and then add a millisecond if necessary:
Dim dblTimestamp As Double
dblTimestamp = Selection.Value ' origin timestamp
' Setup base time increment of 50ms over 20 minutes
For i = 1 To Selection.Rows.Count
Selection.Rows(i).Value2 = dblTimestamp + (2# / (864000# * 4#))
dblTimestamp = dblTimestamp + (2# / (864000# * 4#))
' check to see if previous value ended in 9 indicating loss of precision
' e.g. 05:30:00.999 instead of 05:30:01.000
If Right(Selection.Rows(i).Cells(1).Text,1)="9") Then
dblTimestamp = dblTimestamp + (1#/86400000#) ' add 1 ms
Selection.Rows(i).Value2 = dblTimestamp
End If
Next i
This was good enough for my situation but P57's answer should still be good enough for other situations.