Conditional Formatting again

[Robert Brydges]

Hi there. I want to apply conditional formatting (cell interior and
cell pattern) on 12 or more criteria (values) to the cell containing
the value and the cell offset 1 column to the right, for each cell in a
range A1:A75. Having looked at the archives, the closest I have found
was this code from
Ken Wright:

Private Sub Worksheet_Calculate()
'Code must be placed in the codemodule of the actual sheet you are
working
with.
Dim oCell As Range
For Each oCell In Range("A1:A20")
Select Case oCell.Value
Case Is < 1
oCell.Interior.ColorIndex = xlNone
Case Is = 1
oCell.Interior.ColorIndex = 5
Case Is = 2
oCell.Interior.ColorIndex = 3
Case Is = 3
oCell.Interior.ColorIndex = 6
Case Is = 4
oCell.Interior.ColorIndex = 4
Case Is = 5
oCell.Interior.ColorIndex = 7
Case Is = 6
oCell.Interior.ColorIndex = 15
Case Is = 7
oCell.Interior.ColorIndex = 40
Case Is > 7
oCell.Interior.ColorIndex = xlNone
End Select
Next oCell
End Sub

This does everything except the offset to the right. Any suggestions?

Many thanks

Robert

 

[Dave Peterson]

oCell.Interior.ColorIndex = xlNone
becomes
oCell.resize(1,2).Interior.ColorIndex = xlNone

(.resize(1,2) says to make it 1 row by 2 columns).

And don't forget to change the range.

 

[Robert Brydges]

Dave - It works! Many thanks.

BUT I still have 1 problem. I actually want to do this for a series of
6 ranges (f4:f56,i4:i56,l4:l56,o456,r4:r56,u4:u56). If I include all
6 ranges in a single Sub procedure, I get a Run time Error Type 13,
highlighting the first Case (ie Case oCell.Value Is <1). If I separate
them into 6 procedures, the first 2 work fine, but I get the same error
on pasting in the 3rd Procedure (ie the 3rd range). Any idea what is
going on?

Many thanks,

Robert

 

[Dave Peterson]

How did you do it?

Like this:

For Each oCell In Range("A1:A20,f4:f56,i4:i56,l4:l56,o456,r4:r56,u4:u56")

or something else?

 

[Robert Brydges]

The code is as follows:
Private Sub Worksheet_Calculate()

Dim oCell As Range
For Each oCell In
Range("f4:f56,i4:i56,l4:l56,o456,r4:r56,u4:u56")
Select Case oCell.Value
Case Is < 1
oCell.Resize(1, 2).Interior.ColorIndex = 16
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 1
oCell.Resize(1, 2).Interior.ColorIndex = 6
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 2
oCell.Resize(1, 2).Interior.ColorIndex = 6
oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
Case Is = 3
oCell.Resize(1, 2).Interior.ColorIndex = 37
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 4
oCell.Resize(1, 2).Interior.ColorIndex = 37
oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
Case Is = 5
oCell.Resize(1, 2).Interior.ColorIndex = 41
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 6
oCell.Resize(1, 2).Interior.Color = RGB(255, 238, 130)
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 7
oCell.Resize(1, 2).Interior.ColorIndex = 7
oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
Case Is = 8
oCell.Resize(1, 2).Interior.Color = RGB(70, 238, 130)
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 9
oCell.Resize(1, 2).Interior.ColorIndex = 15
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is = 10
oCell.Resize(1, 2).Interior.ColorIndex = 2
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is < 100
oCell.Resize(1, 2).Interior.ColorIndex = 7
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is > 99
oCell.Resize(1, 2).Interior.Color = RGB(255, 70, 255)
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
End Select
Next oCell

End Sub

It works fine if I limit it to f4:f56, and it works if I just add a
second range i4:i56, but I get the runtime error mismatch 13 when I add
the third range l4:l56 - this happens whether I do it in the form of a
single procedure or a series of 6 procedures with identical code except
for the ranges. What do you think?

Thanks,
Robert

 

[Dave Peterson]

Is this the line that's causing the error?

Select Case oCell.Value

if yes, then maybe you have an error in that cell.

for each oCell in range(...)
If iserror(ocell.value) then
'skip it
else
select case ocell.value
'all that code....
End Select
end if
next oCell

 

[Robert Brydges]

The line
Case Is < 1
gets illuminated.
But the identical code works fine for the first two ranges??

 

[Dave Peterson]

Maybe putting a:

Msgbox oCell.text
or
msgbox oCell.Value
right above would help debug the problem

And what version of excel are you running.

IIRC, xl97 had problems comparing text with numbers (but I could be
misremembering).

Maybe:

If isnumeric(ocell.value) = false then
'skip it
else
'....

 

[Alex Anh]

I use the above codes, and it works fine without any error, I use Excel
2003 version.
Alex Anh