Read from and write to multiple worksheet cells using array variables
2020-06-15 Arrays 0 686
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