Looping Through A Range Efficiently

Category: General VBA | [Item URL]

A common type of macro involves looping through a range of cells, and performing an action based on the contents of each cell. For example, you may want to make the cell bold if the value in the cell is negative. This tip describes how to create such a macro. You should be able to adapt the technique described here to handle your own needs.

I list several macros, each increasingly more sophisticated.

Looping Through a Range: Take 1

The subroutine below demonstrates how to loop through all cells in the current selection. The routine checks the value of each cell in the range and adjusts the Bold property of the Font object accordingly. Notice that the subroutine starts by ensuring that the selection consists of a range.

Sub BoldNegative()
    If TypeName(Selection) <> "Range" Then Exit Sub
    For Each cell In Selection
        If cell.Value < 0 Then cell.Font.Bold = True Else Font.Bold = False
    Next cell
End Sub

Looping Through a Range: Take 2

The previous subroutine works fine in most situations. But what if the selection consists of one or more entire rows or columns? Excel users are accustomed to selecting entire rows and columns, so your macro should be able to handle this type of situation. If you select an entire row before running the preceding macro, you'll find that it works, but it's not very efficient - and excruciatingly slow since it checks every cell in the selection. Ideally, the macro should just examine the non-empty cells. You can accomplish this by using the SpecialCells method of the Range object (refer to the online help for details).

The subroutine below improves upon the previous routine. It examines only the non-empty cells in the selection. It does this by first checking the cells with constants, and then the cells with formulas. Notice the use of the On Error statement. This is necessary because the SpecialCells method returns an error if no cells qualify. You'll find that this routine works equally fast even if the entire worksheet is selected.

Sub BoldNegative()
    If TypeName(Selection) <> "Range" Then Exit Sub
    On Error Resume Next
'   Check the cells with constants
    For Each cell In Selection.SpecialCells(xlConstants, 23)
        If cell.Value < 0 Then cell.Font.Bold = True Else cell.Font.Bold = False
    Next cell
'   Check the cells with formulas
    For Each cell In Selection.SpecialCells(xlFormulas, 23)
        If cell.Value < 0 Then cell.Font.Bold = True Else cell.Font.Bold = False
    Next cell
End Sub

Looping Through a Range: Take 3

The preceding subroutine works fine, but it is not as efficient as it could be. You'll notice that a block of code is repeated. When code is repeated in a routine, you can often create a separate procedure, and then call the procedure rather than repeat your code. This is demonstrated in the two subroutines below. The CheckCells subroutine takes a Range object argument, and is called twice by the BoldNegative procedure.

Sub BoldNegative()
    If TypeName(Selection) <> "Range" Then Exit Sub
    On Error Resume Next
'   Check the cells with constants
    Call CheckCells(Selection.SpecialCells(xlConstants, 23))
'   Check the cells with formulas
    Call CheckCells(Selection.SpecialCells(xlFormulas, 23))
End Sub

Sub CheckCells(CurrRange As Range)
    For Each cell In CurrRange
        If cell.Value < 0 Then cell.Font.Bold = True Else cell.Font.Bold = False
    Next cell
End Sub

Looping Through a Range: Take 4

If a single cell is selected when the preceding BoldNegative subroutine is executed, you'll find that all non-blank cells in the worksheet are examined. This may not be what you want. Therefore, it's necessary to make one additional check - to determine if the selection consists of a single cell. If so, only that cell is checked. The routine below incorporates this modification (the CheckCells routine is unchanged).

Sub BoldNegative()
    If TypeName(Selection) <> "Range" Then Exit Sub
'   If one cell is selected, check it and exit
    If Selection.Count = 1 Then
        CheckCells (Selection)
        Exit Sub
    End If
    On Error Resume Next
'   Check the cells with constants
    Call CheckCells(Selection.SpecialCells(xlConstants, 23))
'   Check the cells with formulas
    Call CheckCells(Selection.SpecialCells(xlFormulas, 23))
End Sub