calculating heading from latitude and longitude in excel - excel

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

Related

VBA Stock info function with different calculations based on one input

I am trying to code a VBA function Stock_Info that will calculate the sharpe ratio if you input sharpe, the CAPM Beta if you input beta and the CAPM Alpha if you input alpha.
The risk free rate (RF) will only be given in a single cell, not as a range, unlike the Returns of the stock.
The STOCK_RET is given in monthly returns, same as the MKT_RET (Which will only be used for the CAPM calculations).
I need to find the excess return by substracting the risk-free rate (RF) from the STOCK_RET. How does one best do this when STOCK_RET is a range and RF is a value of 0.25 given in one single cell?
Furthermore how does one make it so the input under CHOICE will determine what calculation the function will do? My best guess is the IF CHOICE = sharpe Then but there may be a better way?
Here's the code I got so far.
Function Stock_Info(STOCK_RET As Range, RF As Single, CHOICE As Parameter, Optional MKT_RET As Range)
Dim AverageReturn As Double
Dim StandardDev As Double
Dim ExcessReturn() As Double
Dim Sharpe_ratio As Double
If CHOICE = sharpe Then
ExcessReturn(i) = STOCK_RET(i) - RF
AverageReturn = Application.WorksheetFunction.Average(ExcessReturn)
StandardDev = Application.WorksheetFunction.StDev_S(ExcessReturn)
Sharpe_ratio = AverageReturn / StandardDev
ElseIf CHOICE = beta Then
ElseIf CHOICE = alpha Then
End If
End Function

Generating random colors with a bias to one color using Excel VBA

I am trying to generate random colors (2,6) using the following code below; however, my end goal is to generate white color (2) more than the rest of the colors. Would appreciate if someone could help. Thank you.
GenerateColor = Int(Rnd() * 5) + 2
It is a probably a good idea to separate the randomization logic and the logic, which forces a given color to be created more often. E.g., this one works quite ok, giving equal chances to each number:
randomColor = CLng(rnd() * 5) + 2
However, once you obtain the randomColor, it could be changed based on some percentage, named priorityPercentage in the function:
Public Sub TestMe()
Dim counter As Long
Dim randomColor As Long
With Worksheets(1)
.Cells.Clear
For counter = 1 To 1000000
randomColor = CLng(rnd() * 5) + 2
.Cells(counter, 1) = GenerateColor(randomColor, 2, (0.4 - 0.4 * 1 / 6))
Next
.Cells(1, 2).Formula = "=COUNTIF(A:A,2)"
End With
End Sub
Public Function GenerateColor(randomColor As Long, _
priorityColor As Long, _
priorityPercentage As Double) As Long
If rnd() <= priorityPercentage Then
GenerateColor = priorityColor
Exit Function
End If
GenerateColor = CLng(rnd() * 5) + 2
End Function
This example runs 1 million times and it writes in B2 the count of the 2. The reason to pass 0.4 - 0.4 * 1.6 in the parameter, is to make sure, that the chance for 2 is exactly 40%. We have 1/6 for each of the possible 6 numbers - [2,3,4,5,6,7]. Thus, the times when we do not enter in If rnd() <= priorityPercentage are also taken into account.

Scaled Complementary Error Function, erfcx(x), computation avoiding arithmetic overflow - VBA/Excel

I need an algorithm/approximation to compute the Scaled Complementary Error Function, erfcx(x) to double-float precision.
I'm on a work PC so I’m limited to using Excel and VBA and I cannot use external libraries or add-ins: I need to code this myself.
Excel only provides erf() and erfc() functions.
The relationship erfcx(x) = exp(x^2) erfc(x) is obviously useful, however there is arithmetic over/underflow for x larger than around 26.5 and I need to go larger than this.
The below post discussed a python implementation – but it doesn’t seem to resolve the issue from what I can tell. It provides solutions using other libraries or an approximation that isn’t precise enough for my needs.
Is there a scaled complementary error function in python available?
Any suggestions?
Update:
I used this Continued Fraction representation I found on Wikipedia
and a modified version of the algorithm for solving continued fractions found here http://finance4traders.blogspot.nl/2009/07/continued-fractions-and-modified-lentzs.html
The following code seems to work and actually takes fewer iterations for larger input parameters.
Function erfcx(x) As Variant
Dim Ai As Double
Dim Bi As Double
Dim Ci As Double
Dim Di As Double
Dim Ei As Double
Dim Fi As Double
Dim X2 As Double
Dim i As Long
Const SQRPI As Double = 1.7724538509055
Const MAX_ITERATIONS = 1000
If x < 26.5 Then
erfcx = Application.WorksheetFunction.ErfC_Precise(x) * Exp(x ^ 2)
Else
X2 = x ^ 2
Bi = X2
Fi = X2
Ci = X2
Di = 0
Do
i = i + 1
Ai = i / 2
If i Mod 2 = 0 Then
Bi = X2
Else
Bi = 1
End If
Di = 1 / (Bi + Ai * Di)
Ci = Bi + Ai / Ci
Ei = Ci * Di
Fi = Fi * Ei
Loop While Ei <> 1 And i < MAX_ITERATIONS
Debug.Print i
erfcx = x / Fi / SQRPI
End If End function
Several approximations are discuss here:
AMS Journal Article
Once you have determined which approximation is suitable, we can help you code it in either a worksheet function or a VBA UDF()

Zip code distance calculator

I have a spreadsheet of addresses and I need to calculate the distance between all of their zip codes and my zip code. I'm fairly flexible on the method used, but I'm hoping for some sort of webservice or mathematic algorithm. US addresses only. Basically I need to feed in 2 zip codes and get out the distance between them.
I'm willing to use Excel formulas or VBA, and I can even code something in C#.net if needed.
How would you go about calculating these distances?
You could use Latitude and Longitude.
Excel:
=IF(SIN(Lat1) * SIN(Lat2) + COS(Lat1) * COS(Lat2) * COS(Long1 - Long2) > 1,
RadiusofEarth * ACOS(1), RadiusofEarth *
ACOS(SIN(Lat1) * SIN(Lat2) + COS(Lat1) * COS(Lat2) * COS(Long1-Long2)))
VB.net imports System.Math
Private Function Distance(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
Dim theta As Double = lon1 - lon2
Dim dist = System.Math.Sin(deg2rad(lat1)) * System.Math.Sin(deg2rad(lat2)) + System.Math.Cos(deg2rad(lat1)) * System.Math.Cos(deg2rad(lat2)) * System.Math.Cos(deg2rad(theta))
dist = System.Math.Acos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
Select Case unit
Case "K"
dist = dist * 1.609344
Case "N"
dist = dist * 0.8684
End Select
Return dist
End Function
Other Useful Links(First one also mentions VBA alternatives)
ExcelLatLong (Also mentions VBA alternatives)
Zips by Lat Long Lookup
VBA discussion
EDIT: Link added due to comment discussion
More Info(Excel Formula)
It's pretty simple actually. Download a database of zip codes' GPS coordinates, there's plenty of sites that have this data available for download. They would list the coordinates for the center of the zip code.
Use a formula to calculate shortest distance: (ex: http://www.movable-type.co.uk/scripts/latlong.html)

Find distance between two cities in Excel using Google Maps API

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.

Resources