Looping through a selected range efficiently

A common task is to create a macro that evaluates each cell in a range and performs an operation if the cell meets a certain criterion. The procedure that follows is an example of such a macro. The ColorNegative procedure sets the cell's background color to red for cells that contain a negative value. For non-negative value cells, it sets the background color to none. Note

This example is for educational purposes only. Using Excel's conditional formatting is a much better approach.

Sub ColorNegative() ' Makes negative cells red Dim cell As Range

If TypeName(Selection) <> "Range" Then Application.ScreenUpdating = False For Each cell In Selection If cell.Value < 0 Then cell.Interior.Color = RGB(255,

Else cell.Interior.Color = xlNone End If Next cell End Sub

The ColorNegative procedure certainly works, but it has a serious flaw. For example, what if the used area on the worksheet were small, but the user selects an entire column? Or ten columns? Or the entire worksheet? There's no need to process all of those empty cells, and the user would probably give up before all the cells were evaluated.

A better solution (ColorNegative2 ) follows. In this revised procedure, I create a Range object variable, WorkRange , which consists of the intersection of the selected range and the worksheet's used range. Figure 11-8 shows an example; the entire column D is selected (1,048,576 cells). The worksheet's used range, however, consists of the range B2:I18. Therefore, the intersection of these ranges is D2:D18, which is a much smaller range than the original selection. The time difference between processing 16 cells versus processing 1,048,576 cells is significant.

Exit Sub

B

1

■J

t

-1

1

<9

7

■i

i

■J

.5

ri

■ 1)0

■ I

Id

9

■ID

4

-i

1

i

J

-ft

■J

S

1

*

-t

1

I

ft

'

0

-4 j

■i

-J

7

i

1

7

■15

*

1

■i

T

i

9

*

-i

J

IB

-1

*

-1

1

i

i

J

-1

■t

3

-e

■i

w

■ I

?

6

T

i

II

a

-1

i

7

7

7

11

H

t

7

t.

10

■ 10

ID

4

13

-3

-i

?

7

a

E

6

9

14

3

■d

11

■10

i

■ 5

1

<4

U

t

A

t

1

■4

a

0

]

i

■i

1

J

-T

C'

17

■i

1

J

-1

1

■1

ft

m

-1

-t

1

■i>

-i

I

19

i>

a

33

11

H

Figure 11-8: Using the intersection of the used range and the selected ranged results in fewer cells to process.

Sub ColorNegative2() ' Makes negative cells red Dim WorkRange As Range Dim cell As Range

If TypeName(Selection) <> "Range" Then Exit Sub Application.ScreenUpdating = False

Set WorkRange = Application.Intersect(Selection, _

ActiveSheet.UsedRange) For Each cell In WorkRange If cell.Value < 0 Then cell.Interior.Color = RGB(255, 0, 0)

Else cell.Interior.Color = xlNone End If Next cell End Sub

The ColorNegative2 procedure is an improvement, but it's still not as efficient as it could be because it processes empty cells. A third revision, ColorNegative3 , is quite a bit longer, but it's much more efficient. I use the SpecialCells method to generate two subsets of the selection: One subset (ConstantCells ) includes only the cells with numeric constants; the other subset (FormulaCells ) includes only the cells with numeric formulas. The code processes the cells in these subsets by using two For Each-Next constructs. The net effect: Only non-blank, non-text cells are evaluated, thus speeding up the macro considerably.

Sub ColorNegative3() ' Makes negative cells red

Dim FormulaCells As Range, ConstantCells As Range Dim cell As Range

If TypeName(Selection) <> "Range" Then Exit Sub Application.ScreenUpdating = False

Create subsets of original selection

On Error Resume Next

Set FormulaCells = Selection.SpecialCells(xlFormulas, xlNumbers) Set ConstantCells = Selection.SpecialCells(xlConstants, xlNumbers) On Error GoTo 0

' Process the formula cells

If Not FormulaCells Is Nothing Then For Each cell In FormulaCells If cell.Value < 0 Then cell.Interior.Color = RGB(255, 0, 0)

Else cell.Interior.Color = xlNone End If Next cell

End If

' Process the constant cells

If Not ConstantCells Is Nothing Then For Each cell In ConstantCells If cell.Value < 0 Then cell.Interior.Color = RGB(255, 0, 0)

Else cell.Interior.Color = xlNone End If Next cell End If End Sub

Note

The On Error statement is necessary because the SpecialCells method generates an error if no cells qualify.

CD-ROM

A workbook that contains the three colorNegative procedures is available on the companion CD-ROM. The file is named ® efficient looping.xlsm .

0 0

Post a comment