If you’d like to loop through all the cells in a sheet, it is very tempting to use something like the following:
Sub LoopThroughCells() Dim rngCell As Range For Each rngCell In Excel.ActiveSheet.Cells 'Type your code here Next rngCell End Sub
The one problem with that method is, if you are using Excel 2007 or later, Excel would be looping through 17,179,869,184 cells. However, there are few tricks that come in handy to reduce that number dramatically.
- UsedRange property of a WorkSheet object
- SpecialCells property of a Range object
- CurrentRegion property of a Range object
Click here to read a very concise article about these properties.
I have two functions here that would help select cells around a cell using these properties and then collect a subset of similar cells in the ‘expanded’ range in a range object. The first function is used to decide which cells you are planning to loop through. The function expands the range passed as the ‘WhichRante’ argument to include the Current Region by default. However, the user could expand the range to include all used cells in a sheet by setting the ‘SheetUsedRange’ argument to TRUE. Finally, the user could also set the ‘SelectCells’ argument to TRUE, to select the range that is being returned by the function.
'=================================================================== 'Function to expand the selection and return the expanded range 'If no range is passed to the function, ActiveCell is used 'If SheetUsedRange is set to TRUE, the entire used range in the 'sheet containing WhichRange is returned. Otherwise, the current 'region is returned. 'The returned range is also selected if SelectCells is set to TRUE 'Author : Ejaz Ahmed 'Date : 21 November 2013 'Website : https://strugglingtoexcel.wordpress.com/ '=================================================================== Function ExpRangeSelection(Optional ByRef WhichRange As Range, _ Optional ByVal SheetUsedRange As Boolean = False, _ Optional ByVal SelectCells As Boolean = False) As Range 'Declare a temporary Range Dim rngTemp As Range 'If no range is passed to the function, use ActiveCell If WhichRange Is Nothing Then Set rngTemp = Excel.ActiveCell Else Set rngTemp = WhichRange End If 'Select cells based on level of expansion required If SheetUsedRange Then 'Set the temporary range to include the usedrange in a sheet Set rngTemp = rngTemp.Worksheet.UsedRange Else 'Set the temporary range to include the current Region Set rngTemp = rngTemp.CurrentRegion End If 'Select the range if user sets SelectCells to TRUE If SelectCells Then rngTemp.Select End If 'Return the temporary Range Set ExpRangeSelection = rngTemp End Function
The Second function is an example to illustrate how you can loop through a range object and collect a subset of it under another range object, based on a criterion. This particular function remembers the colour of the cell passed to it as the ‘WhichCell’ argument; searches through the “Expanded” selection; and returns the cells that have the same colour as ‘WhichCell’.
'=========================================================================== 'Function to return a range object of cells that have the same 'colour as the cell passed as the 'WhichCell' argument. The 'function searches for similar coloured cells in the Current 'Region by default. Similar coloured cells in the UsedRange 'would be selected if the user sets 'SheetUsedRange' to TRUE. 'The range being returned would be selected if the user sets 'SelectCells' to TRUE. 'Author : Ejaz Ahmed 'Date : 21 November 2013 'Website : https://strugglingtoexcel.wordpress.com/ '============================================================================ Function SimilarColourCells(Optional ByRef WhichCell As Range, _ Optional ByVal SheetUsedRange As Boolean = False, _ Optional ByVal SelectCells As Boolean = False) As Range 'Declaring Variables/Objects Dim rngSearchIn As Range 'Range object to Search in Dim rngCell As Range 'Range object to use in the For-Each-Loop Dim rngTempRange As Range 'Range object to contain the 'similar coloured cells temporarily 'If no range is passed to the function, use ActiveCell If WhichCell Is Nothing Then Set WhichCell = Excel.ActiveCell End If Set rngSearchIn = ExpRangeSelection(WhichCell, SheetUsedRange, False) 'Aggregating the cells with similar colours in rngTempRange For Each rngCell In rngSearchIn If rngCell.Interior.ColorIndex = WhichCell(1).Interior.ColorIndex Then If rngTempRange Is Nothing Then Set rngTempRange = rngCell Else Set rngTempRange = Union(rngTempRange, rngCell) End If End If Next rngCell 'Select the range if user sets SelectCells to TRUE If SelectCells Then rngTempRange.Select End If 'Return the temporary Range Set SimilarColourCells = rngTempRange End Function
Here are a few variations of how these functions could be called:
Sub SelectionExamples() Dim rngCell As Range Dim rngResult As Range Set rngCell = Excel.ActiveSheet.Range("E9") 'this could be any range object in your macro 'Expand Selection examples 'Returns the CurrentRegion around the ActiveCell Set rngResult = ExpRangeSelection() 'Returns the UsedRange in ActiveSheet Set rngResult = ExpRangeSelection(, True) 'Returns the CurrentRegion around "E9" and also selects it Set rngResult = ExpRangeSelection(rngCell, False, True) 'Select Similar colour cells examples 'Returns the cells in the currectregion that have the same colour as the activecell Set rngResult = SimilarColourCells() 'Returns the cells in the UsedRange that have the same colour as Cell:E9 and selets it Set rngResult = SimilarColourCells(rngCell, False, True) End Sub
It is a good practice to write generic codes such as this as functions or Subs that accept arguments, and call them from another sub. This would allow them to be called from any Sub in future, with minimal alterations.