Read from and write to multiple worksheet cells using array variables

 2020-06-15    Arrays    0    694

The preferred and quickest method to read information from multiple worksheet cells is to read the information into an array variable using a single read operation.
When you are reading information from worksheet cells into an array variable the Variant datatype is the preferred one to avoid problems with mixed datatypes since worksheet cells can contain multiple data types, including error values.
The preferred and quickest method to write multiple items to a worksheet range is using an array variable and write all the information using one single write operation.

Sub Example_ReadingFromAndWritingToMultipleCells()
    Dim varItems As Variant
    ' reading information from multiple cells into a variant variable returns a two-dimensional array (lower bound = 1)
    ' reading information from a single cell into a variant variable returns the cell value/formula only (not an array variable)
    varItems = Range("A1:D1000").Value ' read multiple values from a cell range
    'varItems = Range("A1:D1000").Formula ' read multiple formulas from a cell range
    'varItems = Range("A1:D1000").FormulaR1C1 ' read multiple formulas in R1C1 format from a cell range
    'varItems = Worksheets("WorksheetName").Range("DefinedRangeName").Value ' read multiple values from a named cell range
    'varItems = Worksheets("WorksheetName").ListObjects(1).Range.Value ' read multiple values from a defined table range (included the header row)
    'varItems = Worksheets("WorksheetName").ListObjects(1).DataBodyRange.Value ' read multiple values from a defined table range (excluded the header row)

    ' do something with the array variable
    Array_ReplaceErrors varItems ' replace any error values with a blank string
    
    ' write the array variable to the worksheet
    Range("A1:D1000").Formula = varItems ' write multiple values or formulas back to the original cell range
    'Range("A1:D1000").FormulaR1C1 = varItems ' write multiple formulas in R1C1 format back to the original cell range
    Range("F1:I1000").Formula = varItems ' write multiple values or formulas to a different cell range with the same size as the original cell range
    Range("K1").Resize(UBound(varItems, 1), UBound(varItems, 2)).Formula = varItems ' write a two-dimensional array with lower bound = 1 to a range starting at the given cell
    'Range("K1").Resize(UBound(varItems, 1), UBound(varItems, 2)).FormulaR1C1 = varItems ' write a two-dimensional array with lower bound = 1 to a range starting at the given cell
    
    ' read information from the selected cells and handle multiple selected areas
    ' if you want to process a range containing multiple areas you can do something like this:
    Dim objRange As Range, objArea As Range
    On Error Resume Next ' ignore error when no cells are selected
    'varItems = Selection.Value ' this will only return data from the first selected cell range
    Set objRange = Selection ' assign the selected cell range to a range variable
    On Error GoTo 0
    If Not objRange Is Nothing Then ' a cell range was selected
        For Each objArea In objRange.Areas ' process each area of the selected cell range
            varItems = objArea.Value ' read values from the range area (1 or more cells)
            If Not IsArray(varItems) Then ' the area was a single cell only
                If IsError(varItems) Then varItems = vbNullString ' do something with the single cell value
            Else ' do something with the array variable
                Array_ReplaceErrors varItems ' replace any error values with a blank string
            End If
            objArea.Formula = varItems ' write the content back to the range area (1 or more cells)
        Next objArea ' process the next range area
    End If
    
    ' another option is to read the content from multiple areas into one single array variable
    ' this can be useful if you are reading data from e.g. a filtered range and only wants data from the visible rows
    ' you will not be able to write the array content back to their original cells like in the example code block above
    Dim objFilterRange As Range
    On Error Resume Next
    Set objFilterRange = Worksheets(1).Range("MyFilteredDataSource").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    varItems = Range_GetItems(objFilterRange) ' will also replace any error values with a blank string
    If IsArray(varItems) Then ' do something with the array variable
        With Worksheets(2)
            .Cells.ClearContents ' clear any existing content in the worksheet
            .Range("A1").Resize(UBound(varItems, 1), UBound(varItems, 2)).Formula = varItems ' write a two-dimensional array with lower bound = 1 to a range starting at the given cell
        End With
    End If
End Sub

Function Range_GetItems(objRange As Range, Optional blnCleanErrorValues As Boolean = True, Optional blnReturnFormulaR1C1 As Boolean = False) As Variant
' updated 2020-06-10 by OPE
' returns a two-dimensional array with the values (or formulas) from objRange
' useful if objRange has multiple areas, each area in objRange should have the same column count as the first area
Dim varItems As Variant, varItem(1 To 1, 1 To 1) As Variant
Dim r As Long, c As Long, i As Long, j As Long, coll As Collection, objArea As Range, varResult() As Variant
    Range_GetItems = False
    If objRange Is Nothing Then Exit Function
    
    With objRange
        If .Areas.Count > 1 Then
            Set coll = New Collection
            r = 0: c = 0
            For Each objArea In .Areas
                varItems = Range_GetItems(objArea, blnCleanErrorValues, blnReturnFormulaR1C1)
                If IsArray(varItems) Then
                    r = r + UBound(varItems, 1) ' total rows count
                    If c < 1 Then c = UBound(varItems, 2) ' columns count for the first area
                    coll.Add varItems
                End If
            Next objArea
            If coll.Count > 0 Then
                ReDim varResult(1 To r, 1 To c)
                r = 0
                For Each varItems In coll
                    For i = LBound(varItems, 1) To UBound(varItems, 1)
                        r = r + 1
                        c = 0
                        For j = LBound(varItems, 2) To UBound(varItems, 2)
                            c = c + 1
                            On Error Resume Next
                            varResult(r, c) = varItems(i, j)
                            On Error GoTo 0
                        Next j
                    Next i
                Next varItems
                If blnCleanErrorValues Then Array_ReplaceErrors varResult
                Range_GetItems = varResult
            End If
            Set coll = Nothing
            
        Else
            If .Cells.CountLarge > 1 Then
                On Error Resume Next
                If blnReturnFormulaR1C1 Then
                    varItems = .FormulaR1C1
                Else
                    varItems = .Value
                End If
                On Error GoTo 0
                If blnCleanErrorValues Then Array_ReplaceErrors varItems
                Range_GetItems = varItems
            Else
                If blnReturnFormulaR1C1 Then
                    varItem(1, 1) = .FormulaR1C1
                Else
                    varItem(1, 1) = .Value
                End If
                If blnCleanErrorValues Then Array_ReplaceErrors varItem
                Range_GetItems = varItem
            End If
        End If
    End With
End Function

Sub Array_ReplaceErrors(varArray As Variant, Optional varReplaceWith As Variant = vbNullString)
' updated 2020-06-10 by OPE
' replaces any error values in an array with varReplaceWith
' varArray can be a one- or two-dimensional array with text and/or numbers, or a single text/number value
Dim r As Long, c As Long
    If IsArray(varArray) Then
        On Error Resume Next
        r = UBound(varArray, 1) - LBound(varArray, 1) + 1
        c = UBound(varArray, 2) - LBound(varArray, 2) + 1
        On Error GoTo 0
        If r > 0 Then ' array has content
            If c > 0 Then ' probably a two-dimensional array
                For r = LBound(varArray, 1) To UBound(varArray, 1)
                    For c = LBound(varArray, 2) To UBound(varArray, 2)
                        On Error Resume Next
                        If IsError(varArray(r, c)) Then varArray(r, c) = varReplaceWith
                        On Error GoTo 0
                    Next c
                Next r
            Else ' probably a one-dimensional array
                For r = LBound(varArray, 1) To UBound(varArray, 1)
                    On Error Resume Next
                    If IsError(varArray(r)) Then varArray(r) = varReplaceWith
                    On Error GoTo 0
                Next r
            End If
        End If
    Else ' not an array
        On Error Resume Next
        If IsError(varArray) Then varArray = varReplaceWith
        On Error GoTo 0
    End If
End Sub