Link function to SUb

fazna ali

New Member
Joined
Nov 5, 2012
Messages
12
[/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

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

patel45

Well-known Member
Joined
Jul 15, 2012
Messages
1,953
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
Joined
Nov 5, 2012
Messages
12

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

par60056

Well-known Member
Joined
Jul 26, 2012
Messages
1,581
Office Version
  1. 2011
  2. 2010
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

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
Joined
Nov 5, 2012
Messages
12
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
Joined
Nov 5, 2012
Messages
12

ADVERTISEMENT

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
Joined
Jul 26, 2012
Messages
1,581
Office Version
  1. 2011
  2. 2010
Platform
  1. Windows
  2. MacOS
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
' 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

New Member
Joined
Nov 5, 2012
Messages
12
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
Joined
Jul 26, 2012
Messages
1,581
Office Version
  1. 2011
  2. 2010
Platform
  1. Windows
  2. MacOS
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.
 

Forum statistics

Threads
1,147,957
Messages
5,744,042
Members
423,841
Latest member
barren

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top