VBA Distance between two points (Lat Lon)

[purceld2]

I need to calculate the distance between two address. I have the LAT and LON on all of the addresses... there are tens of thousands of address. I need to do compares

I have found this Excel Formula...not sure how it work though

=ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Lon1-Lon2))) *6371

Any ideas

 

[Special-K99]

Pythagaros Theorem?

Square root of ((Lat2 - Lat1) squared + (Lon2 - Lon1) squared)

 

[purceld2]

Has anybody got a bit of vba code where I can put the lat long in and get the distance between them out?

 

[jolivanes]

The formula looks like a Radius of Curvature formula. Is that so?
However, you don't mention the layout of your sheet, nor if your long and lat are in degr/min/sec or deg and decimals or whatever.
Which Columns and or Rows have the information?
My chrystal ball gave up, otherwise I would have known all of this.

 

[purceld2]

Sorry Jolivanes about the lack of information

Format of lat long below. there will be two set's of lat longs and i need to know the distance between them

Excel 2010
	Q	R
2	Latitude	Longitude
3	57.13740600	-2.09441500
4	57.10872600	-2.09303000
5	57.11579900	-2.08556000
6	57.09557500	-2.25470500
7	57.14973400	-2.14668500
8	57.17227600	-2.14361000
9	57.31110600	-2.25623500
10	57.19871000	-2.17813000
11	57.18022600	-2.18392000
12	57.17027100	-2.09382500
13	57.17409500	-2.08721500
14	57.17376500	-2.13827000
15	56.96249600	-2.20934000
16	57.27051900	-2.36758500
17	57.54695500	-2.96628000
18	51.74824900	-0.33189000
19	51.72887600	-0.33990000
FCT3

 

[shg]

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 point 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

Mutiply the return value by the mean earth radius in whatever units you want for the result (km, statute miles, nautical miles, ...)

See http://www.movable-type.co.uk/scripts/latlong.html for other formulas.

 

[purceld2]

Shg,
Thank you very much, but sorry to be a pain, but if I wanted it in Miles what should I multiply the returned figure by?

thanks again

 

[shg]

Google mean earth radius in miles

 

[blongmire]

I'm trying to include this formula in a loop, and the return value isn't coming out correctly. I've manually checked the values in the cells against the answer i'm receiving from the formula, and it the formula is off by few thousand miles. Can you help me straighten it out? Also, I haven't finished the loop logic to paste the values into the desired cells yet, but I can do that once I'm returning the correct value in my test case.

Sub DistanceCalc()


Dim rowcount As Integer
Dim loopcount As Integer
Dim lat1 As Integer
Dim lon1 As Integer
Dim lat2 As Integer
Dim lon2 As Integer
Dim cellcount As Integer


'rowcount = Worksheets("Unique City List").Cells(Rows.Count, "A").End(xlUp).Row - 1
rowcount = 1
loopcount = 0

lat1 = Worksheets("Unique City List").Range("L2")
' value is 32.7758
lon1 = Worksheets("Unique City List").Range("M2")
' value is -96.7967
Do Until loopcount = rowcount

If loopcount < rowcount Then

cellcount = loopcount + 2

Sheets("Unique City List").Activate
lat2 = Worksheets("Unique City List").Cells(cellcount, 5)
'value is 31.88454
lon2 = Worksheets("Unique City List").Cells(cellcount, 6)
'value is -97.077218

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)

Worksheets("Unique City List").Cells(2, 15).Value = CentralAngle * 3958.75587
'I'm multiplying the return value by the mean radius of the earth in miles


loopcount = loopcount + 1

Else
End If

Loop


End Sub

 

[shg]

How is your data arranged, and what are you trying to populate? Can you put a workbook on box.net and post a link?