I am trying to calculate the distance between 2 points in Access. One table is going to be a list of dealers with Lat/Longs and the other a list of the census tracts in the US by centeroid with Lat/Longs. I would like to get distances for each dealer to all of the census tracts and then be able to pull the census tract data for the ones within a distance say 5 miles and get a sum for the numbers.

Please note I want the distances to be done by a great circle formula because accuracy is extreamly important.

that link, its asp
but u should be able to use the functions

' This routine calculates the distance between two points
' (given the latitude/longitude of those points). It is being
'used to calculate distance between two ZIP Codes or Postal
'Codes using our ZIPCodeWorld(TM) and PostalCodeWorld(TM)
' products.
'Definitions
' South latitudes are negative, east longitudes are
'positive

' Passed to function
'lat1, lon1 = Latitude and Longitude of point 1
'(in decimal degrees)
'lat2, lon2 = Latitude and Longitude of point 2
'(in decimal degrees)
'unit = the unit you desire for results
'where 'M' is statute miles (default)
''K' is kilometers
'N' is nautical miles
''United States ZIP Code/ Canadian Postal Code databases with
'latitude & longitude are available at
'http//www.zipcodeworld.com
'For enquiries, please contact sales@zipcodeworld.com

'Official Web site http//www.zipcodeworld.com
'
'Hexa Software Development Center ? All Rights Reserved 2003
'
'

Const pi = 3.14159265358979

Function distance(lat1, lon1, lat2, lon2, unit)
Dim theta, dist
theta = lon1 - lon2
dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
dist = acos(dist)
dist = rad2deg(dist)
distance = dist * 60 * 1.1515
Select Case UCase(unit)
Case "K"
distance = distance * 1.609344
Case "N"
distance = distance * 0.8684
End Select
End Function

'
' This function get the arccos function from arctan function
'
Function acos(Rad)
If Abs(Rad) <> 1 Then
acos = pi / 2 - Atn(Rad / Sqr(1 - Rad * Rad))
ElseIf Rad = -1 Then
acos = pi
End If
End Function

'
' This function converts decimal degrees to radians
'
Function deg2rad(Deg)
deg2rad = CDbl(Deg * pi / 180)
End Function

'
' This function converts radians to decimal degrees
'
Function rad2deg(Rad)
rad2deg = CDbl(Rad * 180 / pi)
End Function

Not really that deals with zip codes and is the same forumla more or less, but I am working with census tracts and I do not know very much about implementing the vb code within access.

I allready have the tables I need to draw the infromation from.

0

MySQL and the MariaDB variant are among the most used databases in Linux environments, and many critical applications support their data on them. Watch this recorded webinar to find out how Veeam Backup & Replication allows you to get consistent backups of MySQL databases.

Also please note that this is going to potentially be 2 tables with a lot of records (there are 65xxx tracts and the file we are going to link with probably has at least 5xxx dealers) and I want the distance from each dealer to each census tract and then to group them so it only gives me the ones that are within x miles of each dealer it will most likely be 3,5,7 mile areas and then I need a total for the counts from the tract file for each dealer at each distance.

well it says its used to calculate between zipcodes, but they do that using Lat/Long

quote

"This routine calculates the distance between two points (given the latitude/longitude of those points). It is being used to calculate the distance between two ZIP Codes or Postal Codes"

It is not, they are in seperate tables and each table has lat/longs, potentially I want a table that will have as many records as possible something like 5000x65413. Each dealer must be measured to Tract. I know that code will most likely work the formula I am using is basically:
69.041*57.2957795130824*(ACOS(SIN(Lat1/57.2957795130824)*SIN(Lat2/57.2957795130824)+COS(Lat1/57.2957795130824)*COS(Lat2/57.2957795130824)*COS((Long1-Long2)/57.2957795130824)))

except that access does not have the acos function this is where my big problem is, if i solved that I think I could get the rest on my own.

There was at one point a database available from Microsoft called NeatCD which had lots of useful code, including the following module to work with Latitude & Longtitudes - One function calculates the Great Arc distance between two points -

Option Compare Database 'Use database order for string comparisons
Option Explicit

Sub DegToDMS(ByVal L As Double, D As Integer, M As Integer, S As Double)
'
' Converts a decimal degree to Degrees, Minutes, and Seconds
' Seconds may contain up to 3 decimal places.
' e.g. 15.5 -> 15,30,0
'
D = Int(L)
L = (L - D) * 60
M = Int(L)
S = Val(Format((L - M) * 60, "#.###"))
End Sub

Function DegToDMSStr(ByVal L As Double) As String
'
' Converts a decimal value to Degrees, Minutes, and Seconds
' Processes Seconds up to 3 decimal places.
' e.g. 15.5 -> 15 30' 0"
'
Dim D As Integer, M As Integer, S As Double
D = Int(L)
L = (L - D) * 60
M = Int(L)
S = Val(Format((L - M) * 60, "#.###"))
DegToDMSStr = D & " " & M & "' " & S & """"
End Function

Function DMSStrToDeg(ByVal DMS As String) As Double
'
' Converts a string value in the format [d m' s"] to a decimal number.
' Not all elements need be present, and they may contain decimal digits.
' e.g. 15 30' 0" -> 15.5
'
Dim i As Integer, w As String, Temp As Double
Temp = 0
For i = 1 To 3
'w = CutWord(DMS, DMS)
Select Case Right(w, 1)
Case "'"
Temp = Temp + Val(w) / 60
Case """"
Temp = Temp + Val(w) / 3600
Case Else
Temp = Temp + Val(w)
End Select
Next i
DMSStrToDeg = Temp
End Function

Function DMSToDeg(D As Double, M As Double, S As Double) As Double
'
' Converts separate Degree, Minute, Second values into decimal degrees.
' e.g. 15,30,0 -> 15.5
'
DMSToDeg = D + M / 60 + S / 3600
End Function

Function GreatArcDistance(Lat1 As Double, Lon1 As Double, Lat2 As Double, Lon2 As Double, Radius As Double) As Double
'
' Calculates the Great Arc (shortest) distance between 2 locations on the globe.
'
' Uses functions from Trigonometry
'
Dim X1 As Double, Y1 As Double, Z1 As Double, X2 As Double, Y2 As Double, Z2 As Double
Dim CosX As Double, ChordLen As Double
LatLongToXYZ Lat1, Lon1, Radius, X1, Y1, Z1
LatLongToXYZ Lat2, Lon2, Radius, X2, Y2, Z2
ChordLen = Sqr((X1 - X2) * (X1 - X2) + (Y1 - Y2) * (Y1 - Y2) + (Z1 - Z2) * (Z1 - Z2))
CosX = 1 - ChordLen * ChordLen / (2 * Radius * Radius)
Debug.Print X1, Y1, Z1
Debug.Print X2, Y2, Z2
Debug.Print ChordLen, CosX
If CosX = 1 Or CosX = -1 Then
GreatArcDistance = 0
Else
GreatArcDistance = Sqr(1 - CosX * CosX) * Radius * PI() / 2
End If
End Function

Sub LatLongToXYZ(Lat As Double, Lon As Double, Radius As Double, x As Double, y As Double, z As Double)
'
' Converts Latitude, Longitude, Radius to 3d-Cartesian coordinates
'
' Assumes:
' X axis runs through 270 (-X) and 90 (+X) Latitude
' Y axis runs North (+Y) to South (-Y)
' Z axis runs through 0 (-Z) and 180 (+Z) Latitude
'
y = Radius * Sin(Deg2Rad(Lat))
x = Radius * Sin(Deg2Rad(Lon)) * Cos(Deg2Rad(Lat))
z = -Radius * Cos(Deg2Rad(Lon)) * Cos(Deg2Rad(Lat))
End Sub

Sub testxyz()
'
' Procedure to test the LatLongToXYZ and XYZToLatLong functions
'
Dim Lat As Double, Lon As Double, Radius As Double
Dim x As Double, y As Double, z As Double

Lat = 90
Lon = 50
Radius = 1000
LatLongToXYZ Lat, Lon, Radius, x, y, z
Debug.Print Lat; Lon; Radius; x; y; z
XYZToLatLong x, y, z, Lat, Lon, Radius
Debug.Print Lat; Lon; Radius

End Sub

Sub XYZToLatLong(x As Double, y As Double, z As Double, Lat As Double, Lon As Double, Radius As Double)
'
' Converts 3d-Cartesian coordinates to Latitude, Longitude, and Radius
'
' Assumes:
' X axis runs through 270 (-X) and 90 (+X) Latitude
' Y axis runs North (+Y) to South (-Y)
' Z axis runs through 0 (-Z) and 180 (+Z) Latitude
'
' Uses functions from the Trigonometry module
'
Radius = Sqr(x * x + y * y + z * z)
If Abs(Radius) < 0.0000000001 Then Radius = 0 ' Accomodate round-off error
If Radius = 0 Then ' Zero radius has no other coordinates
Radius = 0
Lat = 0
Lon = 0
Else
Lat = Rad2Deg(ArcSin(y / Radius))
If (Lat Mod 90) = 0 Then ' North/South pole has no longitude
Lon = 0
Else
Lon = Rad2Deg(ATan2(-z / Cos(Deg2Rad(Lat)), x / Cos(Deg2Rad(Lat))))
End If
End If
End Sub

0

nick_gmsAuthor Commented:

Grayl, you say X is in Radians I am working with decimal degrees I know I need to convert but are the x and x +1 parts of the original lat longs? If you get this i may have a solution.

http://www.freevbcode.com/ShowCode.asp?ID=5532