Nested Case RowHeight Adjust

**ultimastryder** · 02-23-2010, 03:24 PM

Original cumbersome IF structrure(it works but its slow)

Sub RowHeight()

Dim wSheet As Worksheet
Dim wBook As Workbook

Set wBook = ActiveWorkbook
Set wSheet = wBook.Sheets("Letter1")
wSheet.Activate
If Range("A7") = Range("ADDRESS") Then
Range("A7").RowHeight = 12.75
Else
Range("A7").RowHeight = 12.75
End If

If Range("A8") = Range("ADDRESS") Then
Range("A8").RowHeight = 12.75
Else
Range("A8").RowHeight = 12.75
End If

What I'm leaning towards to speed it up:

If ActiveSheet = Sheets("Letter1") then
Select Case
	blah
	blah
	blah
End Select

Theres a million ways to do this. So I don't know what the best way would be.

**Leith Ross** · 02-23-2010, 04:41 PM

Hello ultimastryder,

The quickest way is to apply the change to an entire range at once rather than to each cell individually. This macro turns off the screen updating so the user does not see the changes while they happen. The user only sees the changes after the screen updating is turned back on.

The entire range is first reset to the normal height. The range is then examined for cells with "ADDRESS" in them. When these are found, a new range, RngX, is created. The new row height is then applied to RngX.

Sub AdjustRowHeight()

  Dim Rng As Range
  Dim RngX As Range
  
    Set Rng = Range("A1:A100")
    
      Application.ScreenUpdating = False
        Rng.Rows.RowHeight = 12.75
        For Each Cell In Rng
          If Cell = "ADDRESS" Then
            If RngX Is Nothing Then Set RngX = Cell
            Set RngX = Union(RngX, Cell)
          End If
        Next Cell
        RngX.Rows.RowHeight = 25
      Application.ScreenUpdating = True
                    
End Sub