Solved

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

Posted on 2013-12-09
328 Views
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
Question by:Paul_ATL
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 2

LVL 32

Accepted Solution

Robberbaron (robr) earned 500 total points
ID: 39707602
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 Comment

ID: 39707754
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 Closing Comment

ID: 39707756
Very fast response and better yet . . . Works great in first run of full data set (huge file)
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.