Code:

```
Sub station()
Dim dn As Double
Dim Holder As Double
Dim numb As Integer
Dim namehold As String
Dim shifter As Integer
Dim counter As Integer
Dim subber As Integer
Dim shifetr2 As Integer
Dim Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double, _
ValuesAsDecimalDegrees As Boolean, _
ResultAsMiles As Boolean
ValuesAsDecimalDegrees = True
ResultAsMiles = False
' station (a,B)
' weatehr ( Xn, Yn)
counter = Range("ao1").Value
For shifter = 1 To counter
Holder = 100
Latitude1 = Range("AL" & shifter).Value
Longitude1 = Range("AN" & shifter).Value
For shifter2 = 52 To 74
Longitude2 = Range("d" & shifter2).Value
Latitude2 = Range("i" & shifter2).Value
dn = GreatCircleDistance * 1
If dn < Holder Then
Holder = dn
Range("ap" & shifter).Value = Range("E" & shifter2).Value
End If
Next
Next
End Sub
Private Const C_RADIUS_EARTH_KM As Double = 6371.1
Private Const C_RADIUS_EARTH_MI As Double = 3958.82
Private Const C_PI As Double = 3.14159265358979
Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double, _
ValuesAsDecimalDegrees As Boolean, _
ResultAsMiles As Boolean) As Double
Dim Lat1 As Double
Dim Lat2 As Double
Dim Long1 As Double
Dim Long2 As Double
Dim X As Long
Dim Delta As Double
If ValuesAsDecimalDegrees = True Then
X = 1
Else
X = 24
End If
' convert to decimal degrees
Lat1 = Latitude1 * X
Long1 = Longitude1 * X
Lat2 = Latitude2 * X
Long2 = Longitude2 * X
' convert to radians: radians = (degrees/180) * PI
Lat1 = (Lat1 / 180) * C_PI
Lat2 = (Lat2 / 180) * C_PI
Long1 = (Long1 / 180) * C_PI
Long2 = (Long2 / 180) * C_PI
' get the central spherical angle
Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + _
Cos(Lat1) * Cos(Lat2) * (Sin((Long1 - Long2) / 2) ^ 2)))))
If ResultAsMiles = True Then
GreatCircleDistance = Delta * C_RADIUS_EARTH_MI
Else
GreatCircleDistance = Delta * C_RADIUS_EARTH_KM
End If
End Function
Function ArcSin(X As Double) As Double
' VBA doesn't have an ArcSin function. Improvise.
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function
```