Go Premium for a chance to win a PS4. Enter to Win

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 348
  • Last Modified:

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.

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.
  • 2
1 Solution
Robberbaron (robr)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 = 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

Paul_ATLAuthor Commented:
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.
Paul_ATLAuthor Commented:
Very fast response and better yet . . . Works great in first run of full data set (huge file)

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now