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:

Expand|Select|Wrap|Line Numbers

 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

Expand|Select|Wrap|Line Numbers

 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

Expand|Select|Wrap|Line Numbers

 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 FiveMileCircleGen function return value type to Variant. It should work.

Expand|Select|Wrap|Line Numbers

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

Regards,
Fish

lasmith329

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

Public Function FiveMileCircleGen(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 :

Expand|Select|Wrap|Line Numbers

 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 :

Expand|Select|Wrap|Line Numbers

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)?

Expand|Select|Wrap|Line Numbers

 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:

Expand|Select|Wrap|Line Numbers

 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

Expand|Select|Wrap|Line Numbers

... 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:

Expand|Select|Wrap|Line Numbers

 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

Quote:

Originally Posted by OldBirdman

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

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.

NeoPa

Quote:

Originally Posted by 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.

Loren, Let me start by saying thank you for posting your solution. It's always good to see, and furthermore allows us to relax somewhat, in the knowledge that your issue is resolved.

However, there seems to be some confusion, as I see a function which returns a string (not an array).

If that's good for you then we needn't worry about the complexities of returning array data from a function. I will also mention at this stage (it didn't seem relevant before, but now you're working with a string it could be) that there are two very handy functions :

Expand|Select|Wrap|Line Numbers

 Split(strData, strSeparator)

     - Converts the data in a string

       to an array using the separator

       specified.

Join(array, strSeparator)

     - Converts the data in an array

       to a string using the separator

       specified.

These functions make working with arrays and strings so much more straightforward.

Welcome to Bytes!

Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

re: Help with Function to return Array - Type Mismatch

Similar Microsoft Access / VBA bytes

/bytes/development

/bytes/it

/bytes/about