Make Your Microsoft Dynamics Investment Count & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Function LLDist(pt1_Lat As Single, pt1_Long As Single, pt2_Lat As Single, pt2_long As Single) As Single
Const EarthR = 6371 'in km
'LLDist = Acos(Cos(Radians(90 - lat1)) * Cos(Radians(90 - lat2)) + Sin(Radians(90 - lat1)) * Sin(Radians(90 - lat2)) * Cos(Radians(Long1 - Long2))) * EarthR
LLDist = CentralAngle(pt1_Lat, pt1_Long, pt2_Lat, pt2_long) * EarthR
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 point in RADIANS using Vincenty formula
'http://www.mrexcel.com/forum/excel-questions/686032-visual-basic-applications-distance-between-two-points-lat-lon.html
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
Function Acos(x As Double)
Acos = WorksheetFunction.Acos(x)
End Function
Function Radians(x As Double)
Radians = WorksheetFunction.Radians(x)
End Function
Sub ProcessMissing()
Dim shtMissing As Worksheet, rngMissing As Range
Dim sCityCode As String, sCountryCode As String, orig_Lat As Single, orig_long As Single
Dim minDist As Single, closestCity As String
Set shtMissing = ActiveWorkbook.Sheets("MissingCityCode")
Set rngMissing = shtMissing.Range("A2") 'the first emptycell
Do While Not IsEmpty(rngMissing)
sCityCode = rngMissing.Offset(0, 2).Value
sCountryCode = rngMissing.Offset(0, 4).Value
orig_Lat = rngMissing.Offset(0, 5).Value
orig_long = rngMissing.Offset(0, 6).Value
sCityCode = FindClosest(sCountryCode, orig_Lat, orig_long)
rngMissing.Offset(0, 2).Value = sCityCode
Set rngMissing = rngMissing.Offset(1, 0)
Loop
End Sub
Function FindClosest(sCountry As String, pt1_Lat As Single, pt1_Long As Single)
Dim shtRef As Worksheet, rngRef As Range
Dim sCityCode As String, sCountryCode As String, pt2_Lat As Single, pt2_long As Single
Dim minDist As Single, closestCity As String, testDist As Single
Set shtRef = ActiveWorkbook.Sheets("CityCodeReference")
Set rngRef = shtRef.Range("A2") 'the first cell
minDist = 999999999 'a large number to start
Do While Not IsEmpty(rngRef)
sCountryCode = rngRef.Offset(0, 2).Value
If sCountryCode = sCountry Then
'check distance
sCityCode = rngRef.Offset(0, 0).Value
pt2_Lat = rngRef.Offset(0, 3).Value
pt2_long = rngRef.Offset(0, 4).Value
testDist = LLDist(pt1_Lat, pt1_Long, pt2_Lat, pt2_long)
If testDist < minDist Then
minDist = testDist
FindClosest = sCityCode
End If
End If
Set rngRef = rngRef.Offset(1, 0)
Loop
End Function
Coord-Sample1.xlsm
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
drag and drop a row in excel 2010 | 5 | 45 | |
Excel to show a dynamic Picklist at level2 | 2 | 23 | |
Create a list of Worksheets based on Cell Value | 14 | 33 | |
How to turn this IF statement into a UDF? | 5 | 25 |
Join the community of 500,000 technology professionals and ask your questions.