Link function to SUb

[fazna ali]

[/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

[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]

 

[patel45]

please change tags, CODE as first and /CODE as last
to change function in sub

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

 

[fazna ali]

[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]
[COLOR=#000000][FONT=Verdana]' 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[/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]GreatCircleDistance = Delta * C_RADIUS_EARTH_KM[/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]

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

 

[par60056]

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]

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]

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.

[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]

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.

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
' 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

 

[fazna ali]

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]

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.