How to convert a Variant array to a Range?

I have a 2D array of type Variant. The size and values that populate the array are generated based on data within a worksheet. Further processing is required on this array,开发者_运维百科 the primary being the interpolation of several values. I am using this interpolation function (I know about excel equivalent functions but a design choice was made not to use them) . The problem I am having is the that the Interpolation function requires a Range object.

I have already tried modifying the function to use a Variant (r as Variant) argument. The following line nR = r.Rows.Count can be replaced with nR = Ubound(r). While this works, I would also like to use this function normally within any worksheet and not change the function in any way.

Sub DTOP()
    Dim term_ref() As Variant
    ' snip '
    ReDim term_ref(1 To zeroRange.count, 1 To 2)

    ' values added to term_ref '

    ' need to interpolate x1 for calculated y1 '
    x1 = Common.Linterp(term_ref, y1) 
End Sub

Interpolation Function

Function Linterp(r As Range, x As Double) As Double
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long

    nR = r.Rows.Count
    ' snipped for brevity ' 
End Function

How do I convert my in-memory variant array to a Range so that it can be used for the interpolate function? (without outputting to a WorkSheet)

Answer

In short, the answer is you can't. A Range object must reference a worksheet.

The changed interpolation function checks the TypeName of the argument and sets the value of nR accordingly. Not the prettiest solution.

As a note, the VarType function proved useless in this situation since both VarType(Variant()) and VarType(Range) returned the same value (i.e vbArray) and could not be used to disambiguate an array from a range

Function Linterp(r As Variant, x As Variant) As Double
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long

    Dim inputType As String
    inputType = TypeName(r)

    ' Update based on comment from jtolle      
    If TypeOf r Is Range Then
        nR = r.Rows.Count
    Else
        nR = UBound(r) - LBound(r) 'r.Rows.Count
    End If
    ' ....
 End Function 

AFAIK, you can't create a Range object that doesn't in some way reference a worksheet location your workbook. It can be something dynamic, liked a Named =OFFSET() function, for example, but it has to tie back to a worksheet somewhere.

Why not change the interpolation function? Keep your Linterp signature as is, but make it into a wrapper for a function that interpolates on an array.

Something like this:

Function Linterp(rng As Range, x As Double) As Double
' R is a two-column range containing known x, known y
' This is now just a wrapper function, extracting the range values into a variant
    Linterp = ArrayInterp(rng.Value, x)

End Function

Function ArrayInterp(r As Variant, x As Double) As Double

Dim lR As Long
Dim l1 As Long, l2 As Long
Dim nR As Long

    nR = UBound(r) ' assumes arrays are all 1-based

    If nR = 1 Then
        ' code as given would return 0, better would be to either return
        ' the only y-value we have (assuming it applies for all x values)
        ' or perhaps to raise an error.
        ArrayInterp = r(1, 2)
        Exit Function
    End If

    If x < r(1, 1) Then ' x < xmin, extrapolate'
        l1 = 1
        l2 = 2
    ElseIf x > r(nR, 2) Then ' x > xmax, extrapolate'
        l2 = nR
        l1 = l2 - 1
    Else
        ' a binary search might be better here if the arrays are large'
        For lR = 1 To nR
            If r(lR, 1) = x Then ' no need to interpolate if x is a point in the array'
                ArrayInterp = r(lR, 2)
                Exit Function
            ElseIf r(lR, 2) > x Then ' x is between tabulated values, interpolate'
                l2 = lR
                l1 = lR - 1
                Exit For
            End If
        Next
    End If

    ArrayInterp = r(l1, 2) _
           + (r(l2, 2) - r(l1, 2)) _
           * (x - r(l1, 1)) _
           / (r(l2, 1) - r(l1, 1))

End Function

here's a function to create a range in a new sheet. You can modify this function by adding another range parameter to provide the starting point for the cell range to hold your array.

Put in the code as is at first and walk thru Sub Test() using debugger to see what it can do for you ...

Function Array2Range(MyArray() As Variant) As Range
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim TmpSht As Worksheet, TmpRng As Range, PrevRng As Range

    X = UBound(MyArray, 1) - LBound(MyArray, 1)
    Y = UBound(MyArray, 2) - LBound(MyArray, 2)

    Set PrevRng = Selection
    Set TmpSht = ActiveWorkbook.Worksheets.Add
    Set TmpRng = TmpSht.[A1]


    For Idx = 0 To X
        For Jdx = 0 To Y
            TmpRng(Idx + 1, Jdx + 1) = MyArray(LBound(MyArray, 1) + Idx, LBound(MyArray, 2) + Jdx)
        Next Jdx
    Next Idx

    Set Array2Range = TmpRng.CurrentRegion
    PrevRng.Worksheet.Activate

End Function

Sub Test()
Dim MyR As Range
Dim MyArr(3, 3) As Variant

MyArr(0, 0) = "'000"
MyArr(0, 1) = "'0-1" ' demo correct row/column
MyArr(1, 0) = "'1-0" ' demo correct row/column
MyArr(1, 1) = 111
MyArr(2, 2) = 222
MyArr(3, 3) = 333

Set MyR = Array2Range(MyArr) ' to range
Range2Array MyR, MyOther     ' and back

End Sub

EDIT ============= ammended sub test() to demo conversion back into array and added quick & dirty piece of code to convert back range into array

Sub Range2Array(MyRange As Range, ByRef MyArr() As Variant)
Dim X As Integer, Y As Integer
Dim Idx As Integer, Jdx As Integer
Dim MyArray() As Variant, PrevRng As Range

    X = MyRange.CurrentRegion.Rows.Count - 1
    Y = MyRange.CurrentRegion.Columns.Count - 1
    ReDim MyArr(X, Y)

    For Idx = 0 To X
        For Jdx = 0 To Y
            MyArr(Idx, Jdx) = MyRange(Idx + 1, Jdx + 1)
        Next Jdx
    Next Idx
    MyRange.Worksheet.Delete

End Sub