#### fazna ali

##### New Member
[/CODE]
Private
Const C_PI As Double = 3.14159265358979 Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _ Latitude2 As Double, Longitude2 As Double) 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 X = 24 ' 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))))) GreatCircleDistance = Delta * C_RADIUS_EARTH_KM 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 Sub Checking() Dim Lat1 As Double Dim Long1 As Double Dim Lat2 As Double Dim Long2 As Double Dim results As Double results = GreatCircleDistance(Lat1, Long1, Lat2, Long2) Do While Not IsEmpty(Cells(4, 1)) Lat1 = Cells(4, 1) Long1 = Cells(4, 2) Lat2 = Cells(4, 3) Long2 = Cells(4, 4) Cells(4, 5) = results Loop End Sub
Code:
``````[COLOR=#333333]Yes, it is not really my own written coding and have been copied from the [/COLOR][COLOR=#333333]([/COLOR][URL="http://www.cpearson.com/excel/latlong.aspx"]Latitude And Longitude[/URL][COLOR=#333333])[/COLOR][COLOR=#333333]and with some modification which by deleting the miles option because I want it to be calculate straightaway to Km and i've deleted ValueAsDecimaldegrees part because my latitude and longitude data in deg:min:sec form.[/COLOR]

[COLOR=#333333]From what I understand, the function cannot stand alone, it have to be put inside the sub or called from the sub. Is it right? The input is the latitude and longitude and i want the function to calculate the distance between the coordinates.[/COLOR]

[COLOR=#333333]Actually, i'm new with vb and do not really know to do programming. I'm just do some reading, try out some examples and finding coding that quite related to what i'm going to do and modify it to what i understand.[/COLOR]``````

### Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

#### patel45

##### Well-known Member
please change tags, CODE as first and /CODE as last
to change function in sub
Code:
``````Sub GreatCircleDistance()
Dim Lat1 As Double,Latitude1 As Double
Dim Lat2 As Double,Longitude1 As Double
Dim Long1 As Double,Latitude2 As Double
Dim Long2 As Double,ValuesAsDecimalDegrees As Double
Dim X As Long,ResultAsMiles As Double
Dim Delta As Double, As DoubleLatitude1 = number
Longitude1 = number
Latitude2 = number
Longitude2 = number
ValuesAsDecimalDegrees = number
ResultAsMiles  = number``````

Last edited:

#### fazna ali

##### New Member

Code:
``````[COLOR=#000000][FONT=Verdana]Private Const C_RADIUS_EARTH_KM As Double = 6371.1
Private Const C_PI As Double = 3.14159265358979[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double) As Double[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Dim Lat1 As Double
Dim Lat2 As Double
Dim long1 As Double
Dim long2 As Double
Dim X As Long
Dim Delta As Double[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]X = 24[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]' convert to decimal degrees
Lat1 = Latitude1 * X
long1 = Longitude1 * X
Lat2 = Latitude2 * X
long2 = Longitude2 * X[/FONT][/COLOR]
Lat1 = (Lat1 / 180) * C_PI
Lat2 = (Lat2 / 180) * C_PI
long1 = (long1 / 180) * C_PI
long2 = (long2 / 180) * C_PI[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]' get the central spherical angle
Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + _
Cos(Lat1) * Cos(Lat2) * (Sin((long1 - long2) / 2) ^ 2)))))[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]End Function[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Function ArcSin(X As Double) As Double
' VBA doesn't have an ArcSin function. Improvise
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Sub Checking()[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Dim Lat1 As Double
Dim long1 As Double
Dim Lat2 As Double
Dim long2 As Double
Dim results As Double[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]results = GreatCircleDistance(Lat1, long1, Lat2, long2)[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Do While Not IsEmpty(Cells(4, 1))
Lat1 = Cells(4, 1)
long1 = Cells(4, 2)
Lat2 = Cells(4, 3)
long2 = Cells(4, 4)[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Cells(4, 5) = results[/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]Loop
End Sub

[/FONT][/COLOR]``````

#### fazna ali

##### New Member
done it patel45
can u help me to figure out the prob now?

#### par60056

##### Well-known Member

you appear to be looping looking at a single cell that is not changed inside the loop.

You calculate results outside the loop

The values that you are passing to the function call do not get values until after the call.

A function can stand alone. That way it can be called as part of a cell formula. In your worksheet you could have something like E4=GreatCircleDistance(A4,B4,C4,D4)

#### fazna ali

##### New Member
So from what I understand from your explanation is, I can delete the 'sub' part and the function can work by itself by using the equation that u've gave me. is that right?

#### fazna ali

##### New Member

par60056 :

i've try the equation that u give, but it give #VALUE! output.
so, what is your suggestion. there are other person give me this coding to change the sub coding that i've made.

Code:
``````[COLOR=#000000][FONT=Verdana][I]Sub Checking()[/I][/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana]    [I]Dim i As Long
Dim Lat1 As Double
Dim long1 As Double
Dim Lat2 As Double
Dim long2 As Double[/I]

[I]Application.ScreenUpdating = False[/I]

[I]i = 4
Do While Not IsEmpty(Cells(i, 1))
Lat1 = Cells(i, 1)
long1 = Cells(i, 2)
Lat2 = Cells(i, 3)
long2 = Cells(i, 4)[/I]

[I]Cells(i, 5) = GreatCircleDistance(Lat1, long1, Lat2, long2)[/I]

[I]i = i + 1
Loop[/I]

[I]Application.ScreenUpdating = True[/I][/FONT][/COLOR]
[COLOR=#000000][FONT=Verdana][I]End Sub[/I][/FONT][/COLOR]``````

BUT it turn out to have compile error:Argument not optional

* i think it because of the

Cells(i, 5) = GreatCircleDistance(Lat1, long1, Lat2, long2)
does not declare all argument from the GreatCicrcleDistance function. but when i put all the arguments to the equation, nothing is happen.
Actually how to apply the function so it can be use in the excel sheet.?
Thank you very much.

#### par60056

##### Well-known Member
what version of Excel are you using?

I took your original function code and put it in a module in a blank workbook. I tossed some numbers in A3, B3, C3 & D3. in E3 I typed "=GreatCircleDistance(A3,B3,C3,D3)" (no quotes) I got an error message that ArcSin is not defined. I went to the Excel help and found they had a section on deriving the values for the undefined functions so I added an ArcSin function. I went back to the sheet and went to cell E3 and pressed enter in the formula and it gave me back the value.

Since I have them all... I checked Excel 2000, 2007 and 2010. None of them have ArcSin as a standard function but all of them tell how to derive it from supported functions. It seems dumb that they just don't define them. But there are 21 functions that they give the formulas to derive in the help.

Code:
``````Private Const C_RADIUS_EARTH_KM As Double = 6371.1
Private Const C_PI As Double = 3.14159265358979

Function ArcSin(x As Double) As Double
ArcSin = Atn(x / Sqr(-x * x + 1))
End Function

Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double) 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
x = 24
' convert to decimal degrees
Lat1 = Latitude1 * x
long1 = Longitude1 * x
Lat2 = Latitude2 * x
long2 = Longitude2 * x
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)))))
End Function``````

#### fazna ali

##### New Member
Can u share with me your workable excel workbook on this function?

One more, can u tell me how to attach file in this forum..?

Thank You.

#### par60056

##### Well-known Member
I don't know about attaching a file. I have a sever distrust of opening other peoples files.

To make the workbook do the following:
1) open new workbook
2) press Alt-F8
3) in the macro name box type any letter and press create. (Doesn't matter what, it will be removed)
4) select the code 2 messages up and copy
5) in the macro editor press Ctrl-A then Ctrl-V
6) now back on the worksheet enter values in the cells A-D and in cell E type =GreatCircleDistance(A3,B3,C3,D3)

Note: When you press = and start typing greatcircle, Excel should show you the function name to choose from.

Replies
6
Views
522
Replies
5
Views
478
Replies
0
Views
369
Replies
7
Views
290
Replies
6
Views
1K

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

1,152,193
Messages
5,768,772
Members
425,492
Latest member
blueexcel123

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back