Hello,
I am trying to write a vba function that finds the smallest distance between two large lists of gps coordinates. I already have a basic formula for calculating each of these, but I need to find this efficient function for determining the next closest gps coordinate and by how much. I have done a little bit of vba programming, though I have done more java in the past. I know I will need some type of loop where it looks to determine whether the newly calculated value is smaller than the current running minimum and if not, skip to the next one. I have some rough "pseudocode" of what i'm looking for.
minDistance(range,originalCoords)
define min double = 0
begin loop
dist = originalCoords - nextCoords \\The actual calculation is a little more
if dist < min \\complicated but it should work
dist = min
loop
end loop
I know there's probably a lot missing, including some reference that stops the loop when it hits the last set of coordinates to calculate and something to return the min value. The value nextCoords would be my next listed coordinates to calculate the distance between from the original. Also, I have one cell for latitude and one for longitude, if that is any help.
Any feedback and help would be greatly appreciated!
Thanks!
P.S. if this is listed on another forum topic already, let me know and I will go to there for help!
Welcome to the forum.
How large are the two lists?
All you want to now is the minimum distance, not the nearest point?
You want to calculate great-circle distance?
Post a workbook with some data.
Microsoft MVP - Excel
Entia non sunt multiplicanda sine necessitate
The lists are about 400 locations in total and i'm trying to find the minimum distance to the next coordinate for each. I am using the great-circle distance formula for each of these but there is 399 calculations for each 400 locations, so that's why I feel some vba programming is necessary. Here is an attached worksheet with a sample of 5 locations, using a rudimentary method to find each of the minimum, but with 400 locations, excel runs out of room and this would take quite a while to accomplish.
test min dist.xls
Update: I ended up making 400 macros (yes, it took me 5 hours, but I got it done) and got my data, but I still want to know how to write a function in vba to do this for me because I will definitely be using this kind of method in future research of my own.
Update 2: I started looking further into VBA and I have come up with some code that seems like it should work. Here it is:
Function FindMinDist(Lat1 As Double, Lon1 As Double)
Dim Index As Integer, Min As Double, Dist As Double
Index = 3
Min = 500
While Index < 404
Index = Index + 1
Dist = WorksheetFunction.Acos(Cos(WorksheetFunction.Radians(90 - Lat1)) * Cos(WorksheetFunction.Radians(90 - Worksheet.Cells(Index, 3))) + Sin(WorksheetFunction.Radians(90 - Lat1)) * Sin(WorksheetFunction.Radians(90 - Worksheet.Cells(Index, 3))) * Cos(WorksheetFunction.Radians(Lon1 - Worksheet.Cells(Index, 3)))) * 3958.756
If Dist < Min And Dist <> 0 Then
Min = Dist
End If
Wend
FindMinDist = Min
End Function
When I try using the function, it gives me back #VALUE! in the cell. I have my latitude in C4:C403 & longitude in D4:D403. Any ideas on how to make this work properly?
Last edited by Maddogwoof; 07-22-2011 at 11:06 AM. Reason: Update 2
Figured it out! All good to go! Wrote it myself. Here it is if anyone is interested:
Function FindMinDist(Lat1 As Double, Lon1 As Double) Dim Index As Integer, Min As Double, Dist As Double, Lat2 As Double, Lon2 As Double Index = 3 Min = 500 While Index < 392 Index = Index + 1 Lat2 = Cells(Index, 3).Value Lon2 = Cells(Index, 4).Value If Cos((90 - Lat1) / 57.2957795130823) * Cos((90 - Lat2) / 57.2957795130823) + Sin((90 - Lat1) / 57.2957795130823) * Sin((90 - Lat2) / 57.2957795130823) * Cos((Lon1 - Lon2) / 57.2957795130823) > 1 Then Dist = 0 Else Dist = WorksheetFunction.Acos(Cos((90 - Lat1) / 57.2957795130823) * Cos((90 - Lat2) / 57.2957795130823) + Sin((90 - Lat1) / 57.2957795130823) * Sin((90 - Lat2) / 57.2957795130823) * Cos((Lon1 - Lon2) / 57.2957795130823)) * 3958.756 End If If Dist < Min And Dist <> 0 Then Min = Dist End If Wend FindMinDist = Min End Function
Last edited by shg; 07-23-2011 at 01:02 PM. Reason: added code tags
Another way:
By passing the range containing the other lat-longs, Excel sees a dependency and will automatically recompute when the data changes. Example usage:Function FindMinDist(lat1 As Double, lon1 As Double, r As Range) As Double Const pi As Double = 3.14159265358979 Const D2R = pi / 180# Dim iRow As Long Dim dMin As Double Dim dAng As Double dMin = 1.79E+308 For iRow = 1 To r.Rows.Count dAng = CentralAngle(lat1, lon1, r(iRow, 1).Value2, r(iRow, 2).Value2) If dAng < dMin Then dMin = dAng Next iRow FindMinDist = dMin End Function Function CentralAngle(ByVal lat1 As Double, ByVal lon1 As Double, _ ByVal lat2 As Double, ByVal lon2 As Double) As Double ' shg 2008-1111 ' Returns central angle between two points in RADIANS using Vincenty formula Const pi As Double = 3.14159265358979 Const D2R As Double = pi / 180# Dim dLon As Double Dim x As Double Dim y As Double ' convert angles from degrees to radians lat1 = D2R * lat1 lat2 = D2R * lat2 dLon = D2R * (lon2 - lon1) ' delta lon x = Sin(lat1) * Sin(lat2) + Cos(lat1) * Cos(lat2) * Cos(dLon) y = Sqr((Cos(lat2) * Sin(dLon)) ^ 2 + (Cos(lat1) * Sin(lat2) - Sin(lat1) * Cos(lat2) * Cos(dLon)) ^ 2) CentralAngle = WorksheetFunction.Atan2(x, y) End Function
=FindMinDist(D2, E2, D4:E392)
The value returned is in radians, which means you can multiply by the earth radius in your preferred units (meters, miles, nautical miles, ...) to get linear (great circle) distance.
Last edited by shg; 07-23-2011 at 01:36 PM.
Microsoft MVP - Excel
Entia non sunt multiplicanda sine necessitate
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks