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

 Image result for cluster geographic coordinates graphic
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

Popular Posts