Range to array of doubles

[VBAhack]

Hi, I'm trying to write a custom spreadsheet function that interfaces to a function that requires arrays of doubles as input. I know I can assign a variant directly to a range, but as far as I know, to get the values to an array of doubles, I need to dimension the array of doubles, then copy the elements in a nested loop (m x n matrix) before passing the array to the function. The return is a 1d array of doubles, which means I need to copy the elements to a 2d array before it can be sent to the spreadsheet cells.

Basically, I'm looking for an easier way to get a range of numbers into an array of doubles and avoid all the allocating/copying back and forth. Any ideas?

[Comintern]

I thought this might be possible by hacking the array:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Type SafeBound
    cElements As Long
    lLbound As Long
End Type

Private Type SafeArray
    cDim As Integer
    fFeature As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgsabound As SafeBound
End Type

Private Const VT_BY_REF = &H4000&
Private Const FADF_VARIANT = &H800

Private Sub ArrayFromRange(oRange As Range)

    Dim vRange As Variant, uArray As SafeArray, dDoubles() As Double, uNew As SafeArray
    Dim lCount As Long, uCache As SafeArray
    
    vRange = oRange.Value
    
    If GetArrayInfo(vRange, uArray) Then                                        'Get the array descriptor.
        LSet uNew = uArray                                                      'Copy it for the new array.
        uNew.cDim = 1                                                           'Set the dimensions to 1.
        uNew.rgsabound.cElements = (oRange.Rows.Count * oRange.Columns.Count)   'Calculate the # of elements.
        uNew.rgsabound.lLbound = 0                                              'Range.Value has LBound 1 -- fix.
        uNew.pvData = uNew.pvData + 8                                           'Offset for Variant descriptor.
        uNew.fFeature = uNew.fFeature Xor FADF_VARIANT                          'Turn off the Variant array flag.
        ReDim dDoubles(0)                                                       'Create a new array descriptor.
        If GetArrayInfo(dDoubles, uCache) Then                                  'Cache the new one (to reset later).
            Call AlterArray(dDoubles, uNew)                                     'Point it at the hacked one.
            For lCount = 0 To UBound(dDoubles)                                  'Loop through. (This is the problem)
                Debug.Print dDoubles(lCount)
            Next lCount
            Call AlterArray(dDoubles, uCache)                                   'Unhack the array to lose scope.
        End If
    End If

End Sub

Private Function GetArrayInfo(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'loads a copy of the SafeArray structure into the UDT.
    
    Dim lPointer As Long, iVType As Integer
    
    If Not IsArray(vArray) Then Exit Function               'Need to work with a safearray here.

    With uInfo
        CopyMemory iVType, vArray, 2                        'First 2 bytes are the subtype.
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.

        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If
        
        CopyMemory uInfo.cDim, ByVal lPointer, 16           'Write the safearray to the passed UDT.
        
        CopyMemory .rgsabound, ByVal lPointer + 16, LenB(.rgsabound)
        GetArrayInfo = True
    End With

End Function

Private Function AlterArray(vArray As Variant, uInfo As SafeArray) As Boolean
    
    'NOTE, the array is passed as a variant so we can get it's absolute memory address.  This function
    'writes the SafeArray UDT information into the actual memory address of the passed array.
    
    Dim lPointer As Long, iVType As Integer

    If Not IsArray(vArray) Then Exit Function

    With uInfo
        CopyMemory iVType, vArray, 2                        'Get the variant subtype
        CopyMemory lPointer, ByVal VarPtr(vArray) + 8, 4    'Get the pointer.

        If (iVType And VT_BY_REF) <> 0 Then                 'Test for subtype "pointer"
            CopyMemory lPointer, ByVal lPointer, 4          'Get the real address.
        End If

        CopyMemory ByVal lPointer, uInfo.cDim, 16           'Overwrite the array with the UDT.

        If uInfo.cDim = 1 Then                              'Multi-dimensions might wipe out other memory.
            CopyMemory ByVal lPointer + 16, .rgsabound, LenB(.rgsabound)
            AlterArray = True
        End If

    End With

End Function

Unfortunately, VB apparently doesn't check the SafeArray structure to see how large the elements are. So, when you loop through the array it steps in 8 byte chunks (size of a double) instead of the 16 byte chunks that it should based on the array descriptor. Works fine if you declare dDoubles as a Variant array though.

If that gives you any ideas, let me know.