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.
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).
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?
I would like to calculate heading direction from the north between 2 points with P1(lat1 , long2) and P2(lat2 long2), in excel.
It depends on what level of accuracy you are looking for. Haversine formula is simple yet may be insufficient since it assumes Earth surface is a perfect sphere (which it is not) and provides only limited accuracy.
Vincenty's formulae provide way better, geodesic grade accuracy (1.46E-6 degrees).
VBA Excel implementation I put together can be found on GitHub: https://github.com/tdjastrzebski/Vincenty-Excel.
VincentyInvFwdAzimuth() function should get you what you need.
I have a function used for ham radio calculations. A "pure" formula was too bulky for me.
Function BearingFromCoord(lat_base_deg, long_base_deg, lat_dest_deg, long_dest_deg As Single) As Long
Dim rad_deg_factor As Single
Dim long_diff As Single
Dim frac0 As Single
Dim frac1 As Single
Dim frac2 As Single
Dim lat_base As Single
Dim long_base As Single
Dim lat_dest As Single
Dim long_dest As Single
Dim bearing As Single
rad_deg_factor = 360 / (2 * pi())
long_diff = (long_base_deg - long_dest_deg) / rad_deg_factor
lat_base = lat_base_deg / rad_deg_factor
lat_dest = lat_dest_deg / rad_deg_factor
frac0 = Sin(lat_base) * Sin(lat_dest) _
+ Cos(lat_base) * Cos(lat_dest) _
* Cos(long_diff)
bearing = rad_deg_factor * Application.WorksheetFunction.Acos((Sin(lat_dest) _
- Sin(lat_base) * frac0) _
/ (Cos(lat_base) * Sin(WorksheetFunction.Acos(frac0))))
If Sin(long_diff) < 0 Then
BearingFromCoord = bearing
Else
BearingFromCoord = 360 - bearing
End If
End Function
Private Function pi() As Single
pi = 3.1415926535
End Function
How can I convert string to long in excel macro. CLng is giving me type mismatch error
Dim wStr As String
Dim w As Long
wStr = "=RAND() * 0.3 + 0.35"
w = CLng(wStr)
The root cause of your error is that CDbl expects a numeric value or a string that looks like a number. the string "=RAND() * 0.3 + 0.35" itself does not look like a number, even though it will evaluate to a number.
What are you actually trying to achieve here?
If its to get a long integer result from the formula =RAND() * 0.3 + 0.35, use
Dim w as Long
w = Rnd() * 0.3 + 0.35
If its to emulate a cell formula use
Dim w as Long
w = Application.Evaluate("=RAND() * 0.3 + 0.35")
As to the formula itself, why this construct? It will return Single in the range [0.35, 0.65) which when rounded to a Long will return 0 or 1 at 50% probability of each.
Why not use
w = Rnd()
or
w = Application.Evaluate("=RAND()")
or
w = Application.WorksheetFunction.RandBetween(0, 1)
or is there some other reason I've missed?
Try the formula for w below.
w = CLng(Evaluate(wStr))
Or forget trying to use an "Excel formula", and go straight to VBA with with its random function counterpart
w = CLng(Rnd() * 0.3 + 0.35)
I would like a table of the following form:
Point A Point B Mileage
Los Angeles Miami 292100
Palo Alto San Francisco 90
I was hoping to use Google Maps or some other geo api to generate mileage based on input cities dynamically. Any ideas on how to do this?
UPDATE It looks like I could use the getDistance() function in GDirections. I could write JavaScript without too much difficulty to do this, but how would I incorporate that into Excel?
I could put the JS in an html file that takes a query string and returns the distance of the route. Then, I could set Excel up to use that connection. Or is that an excessive amount of work? And hasn't something like this been done before?
So, you can use Google's API to get a latitude and longitude for each point (maybe in your case, you just want any point in those cities). Then you can use the Halversine distance formula:
http://en.wikipedia.org/wiki/Haversine_formula
For VBA, I have this function in my library that I got from somewhere. On first glance, it looks right and it yields the distance in kilometers (just convert it to miles for your purpose).
Public Function HaversineDistance(ByVal Lat1 As Double, _
ByVal Lat2 As Double, _
ByVal Long1 As Double, _
ByVal Long2 As Double) As Double
Const R As Integer = 6371 'earth radius in km
Dim DeltaLat As Double, DeltaLong As Double
Dim a As Double, c As Double
Dim Pi As Double
On Error GoTo ErrorExit
Pi = 4 * Atn(1)
'convert Lat1, Lat2, Long1, Long2 from decimal degrees into radians
Lat1 = Lat1 * Pi / 180
Lat2 = Lat2 * Pi / 180
Long1 = Long1 * Pi / 180
Long2 = Long2 * Pi / 180
'calculate change in Latitude and Longitude
DeltaLat = Abs(Lat2 - Lat1)
DeltaLong = Abs(Long2 - Long1)
a = ((Sin(DeltaLat / 2)) ^ 2) + (Cos(Lat1) * Cos(Lat2) * ((Sin(DeltaLong / 2)) ^ 2))
'c = 2 * Application.WorksheetFunction.Atan2(Sqr(a), Sqr(1 - a)) 'expressed as radians
c = 2 * Application.WorksheetFunction.Atan((Sqr(1 - a)) / (Sqr(a)))
HaversineDistance = R * c
ErrorExit:
End Function
(Note to other commenters, I'm not interested in hearing about how such accuracy is unnecessary so please don't bother tell me!)
Google currently only provide legal access to driving distances through the client side APIs (Javascript and Flash). Even if they ever do get round to implementing Issue 235: Get driving directions via HTTP , it would still be against Google's Terms (para 10.12) to use the data for purposes other than display on a Google Map.