Excel VBA - If Else problem - HELP PLEASE

[Xispo]

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

 

[CoRrRan]

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

Try this:

********************************
Do

Select Case ActiveCell
Case Empty
' Do nothing
Case "zone total"
With ActiveCell.Interior
.ColorIndex = 12
.Pattern = xlSolid
End With
Case "regional total"
With ActiveCell.Interior
.ColorIndex = 45
.Pattern = xlSolid
End With
Case Else
With ActiveCell.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End Select
ActiveCell.Offset(1, 0).Activate
Loop Until IsEmpty(ActiveCell) = True And _
IsEmpty(ActiveCell.Offset(1, 0)) = True
********************************

The only problem I see is that you have multiple cells in a column
which are empty. I have changed the "until"-part of the loop so that
it will quit after it finds two empty cells after each other. Perhaps
you want to check this.

The problem was: you created "with"-"end with" statements, and
omitted the "end with"-statements. You also omitted a dot before the
properties of the item in the "with"-statement. Check the VBA-help on
the "with"-"end with" items.

HTH,
CoRrRan

 

[Trevor Shuttleworth]

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