Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Find CityCode based on nearest distance (calculated from coordinates)

Posted on 2013-12-09
3
Medium Priority
?
343 Views
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.

NOTE:
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.
EE-Samples.xlsx
0
Comment
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
  • Learn & ask questions
  • 2
3 Comments
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 2000 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
'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

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

Open in new window

Coord-Sample1.xlsm
0
 

Author Comment

by:Paul_ATL
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

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

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

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,…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
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…

715 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