Select Similar Coloured Cells in a Range

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.

1. UsedRange property of a WorkSheet object
2. SpecialCells property of a Range object
3. 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    : http://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    : http://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.