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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
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…

914 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now