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)
Next
GetArraysFromRange = arrayRng
Erase arrayRng
Exit Function
SingleRange:
Err.Clear
arrayRng(0) = Rng.Value 'BUG
Resume
End Function
CodePudding user response:
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
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
- See how to utilize it in a few of my posts.