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