VBA Type mismatch using RANGE of address for a single cell


Trying to pass a range to an array. If the range is a single cell (e.g "A1") it returns a type mismatch (error 13). It works only if the range passed to the function is at least 2 cells e.g "A1:A2".

arrayrng() = activesheet.range(rng.address).value 'BUG

Also the error handler workaround, when the range is a single cell, has a bug in line:

arrayRng(0) = Rng.Value 'BUG

Public arrayRng() As Variant
    Function GetArraysFromRange(ByVal Rng As Range) As Variant
    Dim j  As Long
On Error GoTo SingleRange
arrayRng() = ActiveSheet.Range(Rng.Address).Value 'BUG

''Make  1D array into 2D array
Dim TempArray() As Variant
Dim i  As Long
ReDim TempArray(1 To UBound(arrayRng), 1 To 2)
For i = 1 To UBound(arrayRng)
    TempArray(i, 1) = arrayRng(i, 1)
Next i
arrayRng = TempArray

' copy array position (1) to position (2)for later modifying
    For j = LBound(arrayRng) To UBound(arrayRng)
       arrayRng(j, 2) = arrayRng(j, 1)
GetArraysFromRange = arrayRng
Erase arrayRng

Exit Function
arrayRng(0) = Rng.Value 'BUG
End Function


GetRange: Return the Values of a Range in a 2D One-Based Array

' Purpose:      Returns the values of a range ('rg') in a 2D one-based array.
' Remarks:      If ˙rg` refers to a multi-range, only its first area
'               is considered.
Function GetRange( _
    ByVal rg As Range) _
As Variant
    Const ProcName As String = "GetRange"
    On Error GoTo ClearError
    If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
        Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        GetRange = Data
    Else ' multiple cells
        GetRange = rg.Value
    End If

    Exit Function
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

Answered By – VBasic2008

Answer Checked By – Willingham (AngularFixing Volunteer)

Leave a Reply

Your email address will not be published.