Solved

Find CityCode based on nearest distance (calculated from coordinates)

Posted on 2013-12-09
3
288 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
  • 2
3 Comments
 
LVL 32

Accepted Solution

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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
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 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 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 …

746 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

16 Experts available now in Live!

Get 1:1 Help Now