I am trying to write some code where I start the cursor in a workbook,
and it loops down until the cell in that column is empty changing the
colours of the cells on the way depending what is in the cell. Here is
my attempted effort. Any help would be great, Thanks

Do

If IsEmpty(ActiveCell) = False Then

ElseIf ActiveCell = "zone total" Then
ActiveCell.Select
With Selection.Interior
ColorIndex = 12
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select

ElseIf ActiveCell = "regional total" Then
ActiveCell.Select
With Selection.Interior
ColorIndex = 45
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select


Else
ActiveCell.Select
With Selection.Interior
ColorIndex = 3
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

End Sub:)


---
Message posted from http://www.ExcelForum.com/

A couple of options:

Sub ChangeColours()
Dim lCurrentColumn As Long ' store for current column number
Dim lCurrentRow As Long ' store for current row number
Dim lLastRow As Long ' store for last row number
Dim lCount As Long ' row counter
lCurrentColumn = ActiveCell.Column ' save current column
lCurrentRow = ActiveCell.Row ' save current row
lLastRow = Cells(Rows.Count, lCurrentColumn).End(xlUp).Row
'MsgBox "CC " & lCurrentColumn & _
" CR " & lCurrentRow & _
" LR " & lLastRow

Application.ScreenUpdating = False
For lCount = lCurrentRow To lLastRow
If IsEmpty(Cells(lCount, lCurrentColumn)) _
= True Then
' do nothing
ElseIf LCase(Cells(lCount, lCurrentColumn)) _
= "zone total" Then
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 12
.Pattern = xlSolid
End With
ElseIf LCase(Cells(lCount, lCurrentColumn)) _
= "regional total" Then
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Else
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
Next 'lCount
Application.ScreenUpdating = True
End Sub

' Or with the Select Case approach ...
Sub ChangeColoursSC()
Dim lCurrentColumn As Long ' store for current column number
Dim lCurrentRow As Long ' store for current row number
Dim lLastRow As Long ' store for last row number
Dim lCount As Long ' row counter
lCurrentColumn = ActiveCell.Column ' save current column
lCurrentRow = ActiveCell.Row ' save current row
lLastRow = Cells(Rows.Count, lCurrentColumn).End(xlUp).Row
'MsgBox "CC " & lCurrentColumn & _
" CR " & lCurrentRow & _
" LR " & lLastRow

Application.ScreenUpdating = False
For lCount = lCurrentRow To lLastRow
Select Case Cells(lCount, lCurrentColumn)
Case Empty
' Do nothing
Case "zone total"
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 12
.Pattern = xlSolid
End With
Case "regional total"
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Case Else
With Cells(lCount, lCurrentColumn).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End Select
Next 'lCount
Application.ScreenUpdating = True
End Sub


They don't select any cells so they should be quicker, particularly if there
are a lot of rows.

Regards

Trevor


"Xispo " wrote in message
...
I am trying to write some code where I start the cursor in a workbook,
and it loops down until the cell in that column is empty changing the
colours of the cells on the way depending what is in the cell. Here is
my attempted effort. Any help would be great, Thanks

Do

If IsEmpty(ActiveCell) = False Then

ElseIf ActiveCell = "zone total" Then
ActiveCell.Select
With Selection.Interior
ColorIndex = 12
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select

ElseIf ActiveCell = "regional total" Then
ActiveCell.Select
With Selection.Interior
ColorIndex = 45
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select


Else
ActiveCell.Select
With Selection.Interior
ColorIndex = 3
Pattern = xlSolid
ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

End Sub:)


---
Message posted from http://www.ExcelForum.com/