Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Faster way to calculate distance between two locations (ZIP codes)

I am writing a VBA script that finds ZIP Codes inside of a specified radius. I have an Access Database with multiple records in a table. Each record has a Name, Address, and Zip Code field on the table. The VBA code on access prompts the user for a zip code and search radius then calculates the distance between the user input zip code and the zip code for each record. Once each distance is calculated the record is displayed to the form as long as it falls within the radius input field.

The code that I have written works but the execution time takes too long (around 30 secs for 2000ish records). How can I decrease the time it takes for this VBA code to run? Here is the code I have written:

Private Sub Command65_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim i, j As Integer
Dim db As Database
Dim rs As Recordset
Dim ZIP, r As Double
Dim arr(33144, 3) As Double
Dim lat1, long1, lat2, long2, theta As Double
Dim Distance As Integer
Dim deg2rad, rad2deg As Double
Const PI As Double = 3.14159265359
'Dim Variables

StartTime = Timer
deg2rad = PI / 180
rad2deg = 180 / PI

r = Text1.Value
ZIP = Text2.Value
'Get radius and prompted zip code from form

Set db = CurrentDb
Set rs = db.OpenRecordset("US Zip Codes")
'Open the Table named "US Zip Codes"

For i = 0 To 33143
    arr(i, 0) = rs.Fields("ZIP")
    arr(i, 1) = rs.Fields("LAT")
    arr(i, 2) = rs.Fields("LNG")
    rs.MoveNext
Next i
'Loop through each Zip Code record and store the Zip Code, Lattitude Point, and Longitude Point to an array

For i = 0 To 33143
    If ZIP = arr(i, 0) Then
        lat1 = arr(i, 1) * deg2rad
        long1 = arr(i, 2) * deg2rad
    End If
Next i
'Loop through the zip code array to get Zip Code's corresponding LAT and LONG

Set rs = db.OpenRecordset("Clinics")
'Open the Table named "Clinics"

For j = 0 To 2094
    If rs("Clinic ZIP") = ZIP Then
        Distance = 0
        'If Zip Code 1 and Zip Code 2 are equal to each other, Distance = 0
    ElseIf rs("Clinic ZIP") <> "" Then
        zip2 = rs("Clinic ZIP")
        For i = 0 To 33143
            If zip2 = arr(i, 0) Then
                lat2 = arr(i, 1) * deg2rad
                long2 = arr(i, 2) * deg2rad
            End If
        Next i
        'Loop through the zip code array to get the second Zip Code's corresponding LAT and LONG
        theta = long1 - long2
        Distance = ArcCOS(Sin(lat1) * Sin(lat2) + Cos(lat1) * Cos(lat2) * Cos(theta)) * rad2deg * 60 * 1.1515
        'Calculate Distance between the two zip codes
    Else
        Distance = 999
        'Set Arbitrary Value if the zip code field is empty
    End If
    rs.Edit
    rs.Fields("Distance") = Distance
    rs.Update
    rs.MoveNext
Next j

Me.Filter = "Distance<=" & r
Me.FilterOn = True
'Filter the table with calculated distance by prompted radius
Forms("Zip Search").Requery
rs.Close
Set rs = Nothing
db.Close

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub
like image 647
Preston White Avatar asked Jan 20 '26 10:01

Preston White


1 Answers

I just did a test with a table of 1,976 restaurant locations:

ID  lon        lat       poi_name                                     
--  ---------  --------  ---------------------------------------------
 1   -114.063   51.0466  Palomino Smokehouse: Calgary, AB             
 2   -114.055   51.0494  Bookers BBQ Grill and Crab Shack: Calgary, AB
 3  -86.97871  34.58037  Big Bob Gibson's Original: Decatur, AL       
 4  -87.01763  34.56587  Big Bob Gibson's #2: Decatur, AL             
 5    -86.364  32.26995  DJ's Old Post Office: Hope Hull, AL          
...

Using the GreatCircleDistance function available from ...

http://www.cpearson.com/excel/LatLong.aspx

... I ran the following query to calculate the distance from a given point

PARAMETERS prmLon IEEEDouble, prmLat IEEEDouble;
SELECT BBQ2.ID, BBQ2.lon, BBQ2.lat, BBQ2.poi_name, 
    GreatCircleDistance([prmLat],[prmLon],[lat],[lon],True,False) AS km
FROM BBQ2;

and the results came back in less than a second.

Then to return results within a certain number of kilometers from a given point I used

PARAMETERS prmLon IEEEDouble, prmLat IEEEDouble, prmWithinKm IEEEDouble;
SELECT * FROM
(
    SELECT BBQ2.ID, BBQ2.lon, BBQ2.lat, BBQ2.poi_name, 
        GreatCircleDistance([prmLat],[prmLon],[lat],[lon],True,False) AS km
    FROM BBQ2
)
WHERE km <= [prmWithinKm];

and again, the results came back in less than a second.

like image 120
Gord Thompson Avatar answered Jan 23 '26 07:01

Gord Thompson



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!