• Status: Solved
• Priority: Medium
• Security: Public
• Views: 350

# Find CityCode based on nearest distance (calculated from coordinates)

Hi Experts,

My level of coding is not sufficient to get this done. Hence, need your help please

I have two tables.
Table.MissingCityCode is a list of location with coordinates (Lat/Lon) but no CityCode
Table.CityCodeReference is a list of known reference with coordinates

What I would like to do, is to have a VBA code that do the following:

For each country code from Table.MissingCityCode
- Look at each row, take the CountryCode, Lat/Long values (say this is point_A)

- Go to Table.CityCodeReference and filter only for the matched country code
- Calculated the distance between point_A and each available row of City (in kilometers)
- Find the nearest one, and take the value from Table.CityCodeReference.CityCode

- Update Table.MissingCityCode.MissingCityCode with value found from above

- Loop for next city in a given countrycode
- Loop for the next countryCode

Please see the sample as attached.

NOTE:
From research, I know the excel formula to calculate distance between two coordinates is

where 6371 is Earth radius in KM.

But, to put the loop and find nearest value as needed here, it is a bit out of my reach.
EE-Samples.xlsx
0
Paul_ATL
• 2
1 Solution

Commented:
here is my attempt.  needs to be a macro enabled workbook

much calcs from other sources.

User defined functions go in a regular module sheet:
``````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 = 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

End Function
``````

Macro and another user defined function also go in a regular module sheet:
``````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
0

Author Commented:
hi robberbaron,

YOU"RE THE MAN !!!

It looks to work great with the sample set as shown in my file.

I just overwrite my sample data set with the real one which has 7300+ of rows for missing citycode and 12K+ rows of known reference code. Ran it on i7 16GB RAM PC - - all is done in 10 mins.  Result looks to be good.
0

Author Commented:
Very fast response and better yet . . . Works great in first run of full data set (huge file)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.