Calculate the Center/Average of Multiple Coordinate Points with Excel VBA

I wanted to calculate a good center/average point for a cluster of geographic coordinates in Excel VBA and came across a JavaScript solution here. All I had to do was rewrite all the logic in VBA. The only real challenge was realizing that Excel's Atan2 function takes (x, y) while JavaScript's atan2 function takes (y, x). Here is my solution:
Function AverageGeolocation(ByRef aCoords) As Coord
'''Calculate the center/average of multiple Geolocation coordinates
'''Expects array of objects named Coord with .latitude and .longitude properties
Dim cOut As New Coord
Dim x As Double
Dim y As Double
Dim z As Double
Dim latitude As Double
Dim longitude As Double
Dim i As Long
Dim Math As Object
Dim total As Double
Dim centralLongitude As Double
Dim centralSquareRoot As Double
Dim centralLatitude As Double
Const PI = 3.14159265358979
Set Math = Application.WorksheetFunction
If UBound(aCoords) = LBound(aCoords) Then
Set AverageGeolocation = aCoords(LBound(aCoords))
Exit Function
End If
For i = LBound(aCoords) To UBound(aCoords)
latitude = aCoords(i).latitude * PI / 180
longitude = aCoords(i).longitude * PI / 180
x = x + Cos(latitude) * Cos(longitude)
y = y + Cos(latitude) * Sin(longitude)
z = z + Sin(latitude)
Next
total = UBound(aCoords) - LBound(aCoords) + 1
x = x / total
y = y / total
z = z / total
centralLongitude = Math.Atan2(x, y)
centralSquareRoot = Sqr(x * x + y * y)
centralLatitude = Math.Atan2(centralSquareRoot, z)
cOut.latitude = centralLatitude * 180 / PI
cOut.longitude = centralLongitude * 180 / PI
Set AverageGeolocation = cOut
End Function
Make sure to make a Class Module (Insert-Class Module) named Coord and add these lines to it:
Public latitude As Double
Public longitude As Double
The output will be a Coord object with the latitude and longitude properties for the center/average point of all the coordinates you passed to the AverageGeolocation function.
Here's a Coord constructor function you can put in a normal module:
Function NewCoord(latitude As Double, longitude As Double) As Coord
Dim cOut As New Coord
cOut.latitude = latitude
cOut.longitude = longitude
Set NewCoord = cOut
End Function
Comments
Post a Comment