Find CityCode based on nearest distance (calculated from coordinates)

Posted on 2013-12-09
Last Modified: 2013-12-09
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.

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

=ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Long1-Long2))) *6371

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.
Question by:Paul_ATL
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
  • Learn & ask questions
  • 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 = 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

    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

Open in new window

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)

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)
End Function

Open in new window


Author Comment

ID: 39707754
hi robberbaron,


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.

Author Closing Comment

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

Featured Post

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

617 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question