Help with Function to return Array - Type Mismatch

[lasmith329]

I've never posted a question on any site before, but after racking my head over this hurdle for days, I've caved. I'm working on a program that creates a kml file and exports it to Google Earth. In that file, I want to create a 5 mile radius circle around the placemark. To do that, I worked with the kml circlegen source I found online in php. It calculates the latitudes and longitudes of the points that make up the circle. The calculation works correrctly (as shown by printing to the immediate window or by calling the sub), but I can't get the function to return the array. As many different ways I've structured it, I keep getting a 'type mismatch'. Any help would be GREATLY appreciated! I believe I've included all the necessary function code:

Option Explicit
 
Private Const Radius5mls As Double = 8046.72           'in meters
Private Const PI As Double = 3.14159265358979
 
 
Public Sub FiveMileRadius(lat1 As Double, lon1 As Double)
    Dim Arr As Variant
    Dim i As Integer
    Arr = FiveMileCircleGen(lat1, lon1)
    If IsArrayAllocated(Arr:=Arr) = True Then
        For i = LBound(Arr) To UBound(Arr)
            Debug.Print Arr(i)
        Next i
    Else
        MsgBox ("Not Allocated")
    End If
 
End Sub

Public Function FiveMileCircleGen(lat1 As Double, lon1 As Double) As Variant()
Dim ResultArray() As Variant
Dim i As Integer
Dim radial As Double, angle As Double
Dim iNumSides As Integer
Dim lat2 As Double
Dim lon2 As Double
Dim dlon As Double
Dim modNum As Double
Dim modDiv As Double
Dim distance As Double
 
'convert coordinates to radians
lat1 = Deg2Rad(lat1)
lon1 = Deg2Rad(lon1)
 
iNumSides = 360
 
distance = Radius5mls / 6378137   'divided by radius of earth at the equator, in meters
 
    ' Create an array to hold all of the points:
    ReDim ResultArray(i To (iNumSides / 2))
 
    ' trigonometry to calculate circles lat/lon points:
    For i = 0 To iNumSides Step 2
        angle = i
        radial = Deg2Rad(angle)
        lat2 = fnArcSineRad(sIn(lat1) * Cos(distance) + Cos(lat1) * sIn(distance) * Cos(radial))
        dlon = ATan2(sIn(radial) * sIn(distance) * Cos(lat1), Cos(distance) - (sIn(lat1) * sIn(lat2)))
        modNum = (lon1 + dlon + PI)
        modDiv = 2 * PI
        lon2 = (modNum - modDiv * Int(modNum / modDiv)) - PI
 
        lat2 = CStr(Rad2Deg(lat2))
        lon2 = CStr(Rad2Deg(lon2))
 
        ResultArray(i) = lon2 & "," & lat2 & ",0 "
        'Debug.Print lon2 & "," & lat2 & ",0 "
 
    Next i
 
    FiveMileCircleGen = ResultArray        ' remove this line and the resultarray(i) line and open the debug line to work
 
End Function

Public Function IsArrayAllocated(Arr As Variant) As Boolean
    On Error Resume Next
    IsArrayAllocated = Not (IsError(LBound(Arr))) And IsArray(Arr) And (LBound(Arr) <= UBound(Arr))
 
End Function
 
 
 
'        Name:      ARC SINE IN RADIANS
'     Purpose:      This function determines the ArcSine of the passed argument.
'      Inputs:      vntSine     The sine of an angle.
' Assumptions:      None.
'     Effects:      Will raise "Overflow" error if vntSine is not a valid sine or
'                   if any other error occurs during execution.
'     Returns:      The angle in radians.
'                   If an error occurs fnArcSine is indeterminate.
'
Public Function fnArcSineRad(vntSine As Variant) As Double
On Error GoTo ERROR_ArcSine                                     ' Trap strangeness.
 
Const cOVERFLOW = 6                                             ' "Overflow" message #.
 
Dim blnEditPassed As Boolean                                    ' Edit results variable.
Dim dblTemp       As Double                                     ' Temporary double.
 
    blnEditPassed = False                                       ' It hasn't passed yet!
    If IsNumeric(vntSine) Then                                  ' Is arg numeric?
        If vntSine >= -1 And vntSine <= 1 Then                  ' Yup, is it within limits?
            blnEditPassed = True                                ' Yup, employ Derived Math Function:
                                                                ' Arcsin(X) = Atn(X / Sqr(-X * X + 1))
            dblTemp = Sqr(-vntSine * vntSine + 1)               ' Calculate denominator.
            If dblTemp = 0 Then                                 ' Is it 0?  Can only happen if arg is +1 or -1.
                fnArcSineRad = Sgn(vntSine) * PI / 2          ' Yup, assign +Pi/2 or -Pi/2 based on sign of arg.
            Else
                fnArcSineRad = Atn(vntSine / dblTemp)           ' Complete derived math function.
            End If
        End If
    End If
 
EXIT__ArcSine:
    If Not blnEditPassed Then Err.Raise cOVERFLOW               ' Raise overflow error if arg failed edits.
    Exit Function
 
ERROR_ArcSine:
    On Error GoTo 0                                             ' Turn off error trapping.
    blnEditPassed = False                                       ' Should never happen!
    Resume EXIT__ArcSine                                        ' But if it does give overflow error.
 
End Function

[FishVal]

Hello.

Variant type includes array.
So, just change FiveMileCircleG en function return value type to Variant. It should work.

Public Function FiveMileCircleGen(lat1 As Double, lon1 As Double) As Variant
 

Regards,
Fish

[lasmith329]

Thanks Fish. When I remove the "()" from

Public Function FiveMileCircleG en(lat1 As Double, lon1 As Double) As Variant()

It then gives me a "Subscript out of range" error. To fix that I change the line to the following:

Redim ResultArray(i To iNumSides)

Now it gives me a 'run-time error 13, type mismatch'

Loren

[NeoPa]

As far as I can tell, there is no way of defining a function explicitly to return an array.

However, it is possible to define it as a Variant, and set the return value as an array (Variants can handle arrays).

This quick function illustrates how this can be done :

Public Function Test() As Variant
    Test = Split("A,B,C", ",")
End Function

Some code to illustrate that this works (and that works from the Immediate pane) is :

For A=0 to 2:?Test()(A),:Next

[NeoPa]

I suggest you may need to build up your array first, with all the flexibility available to properly defined variables, then simply assign this array to the function return value when done.

[OldBirdman]

Why not pass the array to the function (now sub)?

Dim a(1 To 3) As Long
Public Sub xx(ary As Variant)
    ary(1) = 1
    ary(2) = 2
    ary(3) = 3
End Sub
 
Call xx(a)
Debug.Print a(1), a(2), a(3)
 

[NeoPa]

The dimensions may not be known in advance of running the code OB.

In any case, the logic of it would tend to be obscured by that rather than clarified (if that makes sense). The function should be in control of what it produces - rather than being dependant on outside code.

[OldBirdman]

In this case, the dimensions are known. It is a single dimension array. True, long is not the correct type, but I only posted a simple example. I could have posted:

Dim a() As Double
Public Sub xx(ary As Variant)
ReDim a(0 To 2, 1 To 3)
    ary(0, 1) = 1
    ary(0, 2) = 2
    ary(0, 3) = 3
Debug.Print a(0, 1), a(0, 2), a(0, 3)
End Sub

I may not understand, but I thought that when a function was called, any parameters passed "By Reference" were passed as a pointer to the variable. Because any memory is released when a function ends, the return value must be created by the compiler/VBA as workspace within the calling routine, and a pointer to that space passed to the function.
In other words, Call subX(a,b,c) would pass 3 pointers, ptr->a, ptr->b, ptr->c. c=funcX(a,b) would pass 3 pointers, ptr->a, ptr->b, ptr->workspace. Any function could be written as a subroutine if the last line of the subroutine were an assignment to the last argument.
My function is as much in control as any function. When I enter the function line

... Function (arg1, arg2, ...) As Type

where type is a valid data type, I am I not telling the compiler what workspace it needs to generate before it invokes the function? The function is not in control, the calling code is.

I was looking for a solution to lasmith329's problem. There should be no error 13 mismatch with this. That was all I was attempting to do.

[lasmith329]

Thanks for everyone's input. With your help and finding just the right tutorial I was able to finally get the function to return an array. FYI, here's the final code:

Public Function FiveMileCircleGen(lat1 As Double, lon1 As Double) As String
 
Dim ArrayReturned As String
Dim i As Integer
Dim radial As Double, angle As Double
Dim lat2 As Double
Dim lon2 As Double
Dim dlon As Double
Dim modNum As Double
Dim modDiv As Double
Dim distance As Double
Dim lngFN As Long
 
 
'convert coordinates to radians
lat1 = Deg2Rad(lat1)
lon1 = Deg2Rad(lon1)
 
 
Const iNumSides = 360
 
distance = Radius5mls / 6378137   'divided by radius of earth at the equator, in meters
 
    '// Create an array to hold all of the points:
    'ReDim ResultArray (361)
    Dim ResultArray(iNumSides) As String
 
    ArrayReturned = ""
    '// Use trigonometry to points:
    For i = 1 To iNumSides
        angle = i
        radial = Deg2Rad(angle)
        lat2 = fnArcSineRad(sIn(lat1) * Cos(distance) + Cos(lat1) * sIn(distance) * Cos(radial))
        dlon = ATan2(sIn(radial) * sIn(distance) * Cos(lat1), Cos(distance) - (sIn(lat1) * sIn(lat2)))
        modNum = (lon1 + dlon + PI)
        modDiv = 2 * PI
        lon2 = (modNum - modDiv * Int(modNum / modDiv)) - PI
 
        lat2 = Rad2Deg(lat2)
        lon2 = Rad2Deg(lon2)
 
        ResultArray(i) = CStr(lon2 & "," & lat2 & ",0 ")
        ArrayReturned = ArrayReturned & ResultArray(i)
 
    Next i
 
    FiveMileCircleGen = ArrayReturned
 
End Function

[NeoPa]

@OldBirdman
I'm sorry OB. I'm afraid I have a tendency to treat things very literally. In this case I took this as a Request For Comment.

My response was not intended to be critical, and certainly not to imply you shouldn't have posted it. It was simply my opinions of the general approach illustrated in your proposed solution (with supporting rationale).

It's not my habit to offer such opinions unrequested (unless I feel that somehow the code suggested may cause real issues - certainly not the case in this instance), but as I say, I am prone to treat things quite literally. Please ignore if not interested.