'=================================================================================
' Distance Calculator
'=================================================================================
' This function calculates the distance between two latitude/logitude
' coordinates. Disance can be returned as Nautical Miles, Kilometers,
' or Miles (default).
'
' This functionwas designed for VB6
'
' Accepts:
'	Lat1 = Latitude of point one (decimal, required)
'	Lon1 = Longitude of point one (decimal, required)
'	Lat2 = Latitude of point two (decimal, required)
'	Lon2 = Longitude of point two (decimal, required)
'	UnitFlag = Non required character K, N, or M
'		where:
'			K = Kilometers
'			N = Nautical Miles
'			M = Miles [default]
'
' Provided by: http://www.zip-codes.com
'
' © 2005 Zip-Codes.com, All Rights Reserved
'=================================================================================

Public Function DistanceCalc(ByVal Lat1, ByVal Lon1, ByVal Lat2, ByVal Lon2, ByVal UnitFlag)
	Dim LatRad1
	Dim LonRad1
	Dim LatRad2
	Dim LonRad2
	Dim LonRadDif
	Dim RadDist
	Dim X
	Dim PI
	Dim DistMI
	PI = 3.141592653589
	If Not IsNumeric(Lat1) Then
		DistanceCalc = 0
		Exit Function
	End If
	If Lat1 = 0 Or Lon1 = 0 Or Lat2 = 0 Or Lon2 = 0 Then
		DistanceCalc = 0
		Exit Function
	ElseIf Lat1 = Lat2 And Lon1 = Lon2 Then
		DistanceCalc = 0
		Exit Function
	End If
	LatRad1 = Lat1 * PI / 180
	LonRad1 = Lon1 * PI / 180
	LatRad2 = Lat2 * PI / 180
	LonRad2 = Lon2 * PI / 180
	LonRadDif = Abs(LonRad1 - LonRad2)
	X = Sin(LatRad1) * Sin(LatRad2) + Cos(LatRad1) * Cos(LatRad2) * Cos(LonRadDif)
	RadDist = Atan(-X / Sqrt(-X * X + 1)) + 2 * Atan(1)
	DistMI = RadDist * 3958.754
    If UCase("" & UnitFlag) = "K" Then
		DistanceCalc = DistMI * 1.609344
	ElseIf UCase("" & UnitFlag) = "N" Then
		DistanceCalc = DistMI * 0.8684
	Else
		DistanceCalc = DistMI
	End If
End Function


' Examples
msgbox("Examples:")
msgbox(DistanceCalc(30.524, -87.235, 34.097, -118.412, "M") & " Miles")
msgbox(DistanceCalc(30.524, -87.235, 34.097, -118.412, "K") & " Kilometers")
msgbox(DistanceCalc(30.524, -87.235, 34.097, -118.412, "N") & " Nautical Miles")