close

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(quot;A1:A20quot;)
Select Case oCell.Value
Case Is lt; 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 gt; 7
oCell.Interior.ColorIndex = xlNone
End Select
Next oCell
End Sub

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

Many thanks

RobertoCell.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 wrote:
gt;
gt; Hi there. I want to apply conditional formatting (cell interior and
gt; cell pattern) on 12 or more criteria (values) to the cell containing
gt; the value and the cell offset 1 column to the right, for each cell in a
gt; range A1:A75. Having looked at the archives, the closest I have found
gt; was this code from
gt; Ken Wright:
gt;
gt; Private Sub Worksheet_Calculate()
gt; 'Code must be placed in the codemodule of the actual sheet you are
gt; working
gt; with.
gt; Dim oCell As Range
gt; For Each oCell In Range(quot;A1:A20quot;)
gt; Select Case oCell.Value
gt; Case Is lt; 1
gt; oCell.Interior.ColorIndex = xlNone
gt; Case Is = 1
gt; oCell.Interior.ColorIndex = 5
gt; Case Is = 2
gt; oCell.Interior.ColorIndex = 3
gt; Case Is = 3
gt; oCell.Interior.ColorIndex = 6
gt; Case Is = 4
gt; oCell.Interior.ColorIndex = 4
gt; Case Is = 5
gt; oCell.Interior.ColorIndex = 7
gt; Case Is = 6
gt; oCell.Interior.ColorIndex = 15
gt; Case Is = 7
gt; oCell.Interior.ColorIndex = 40
gt; Case Is gt; 7
gt; oCell.Interior.ColorIndex = xlNone
gt; End Select
gt; Next oCell
gt; End Sub
gt;
gt; This does everything except the offset to the right. Any suggestions?
gt;
gt; Many thanks
gt;
gt; Robert

--

Dave Peterson

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 lt;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,

RobertHow did you do it?

Like this:

For Each oCell In Range(quot;A1:A20,f4:f56,i4:i56,l4:l56,o456,r4:r56,u 4:u56quot;)

or something else?

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

--

Dave Peterson

The code is as follows:
Private Sub Worksheet_Calculate()

Dim oCell As Range
For Each oCell In
Range(quot;f4:f56,i4:i56,l4:l56,o456,r4:r56,u4:u56quot;)
Select Case oCell.Value
Case Is lt; 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 lt; 100
oCell.Resize(1, 2).Interior.ColorIndex = 7
oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
Case Is gt; 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,
RobertIs 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 wrote:
gt;
gt; The code is as follows:
gt; Private Sub Worksheet_Calculate()
gt;
gt; Dim oCell As Range
gt; For Each oCell In
gt; Range(quot;f4:f56,i4:i56,l4:l56,o456,r4:r56,u4:u56quot;)
gt; Select Case oCell.Value
gt; Case Is lt; 1
gt; oCell.Resize(1, 2).Interior.ColorIndex = 16
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 1
gt; oCell.Resize(1, 2).Interior.ColorIndex = 6
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 2
gt; oCell.Resize(1, 2).Interior.ColorIndex = 6
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
gt; Case Is = 3
gt; oCell.Resize(1, 2).Interior.ColorIndex = 37
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 4
gt; oCell.Resize(1, 2).Interior.ColorIndex = 37
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
gt; Case Is = 5
gt; oCell.Resize(1, 2).Interior.ColorIndex = 41
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 6
gt; oCell.Resize(1, 2).Interior.Color = RGB(255, 238, 130)
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 7
gt; oCell.Resize(1, 2).Interior.ColorIndex = 7
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternGray8
gt; Case Is = 8
gt; oCell.Resize(1, 2).Interior.Color = RGB(70, 238, 130)
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 9
gt; oCell.Resize(1, 2).Interior.ColorIndex = 15
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is = 10
gt; oCell.Resize(1, 2).Interior.ColorIndex = 2
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is lt; 100
gt; oCell.Resize(1, 2).Interior.ColorIndex = 7
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; Case Is gt; 99
gt; oCell.Resize(1, 2).Interior.Color = RGB(255, 70, 255)
gt; oCell.Resize(1, 2).Interior.Pattern = xlPatternSolid
gt; End Select
gt; Next oCell
gt;
gt; End Sub
gt;
gt; It works fine if I limit it to f4:f56, and it works if I just add a
gt; second range i4:i56, but I get the runtime error mismatch 13 when I add
gt; the third range l4:l56 - this happens whether I do it in the form of a
gt; single procedure or a series of 6 procedures with identical code except
gt; for the ranges. What do you think?
gt;
gt; Thanks,
gt; Robert

--

Dave Peterson

The line
Case Is lt; 1
gets illuminated.
But the identical code works fine for the first two ranges??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
'....Robert Brydges wrote:
gt;
gt; The line
gt; Case Is lt; 1
gt; gets illuminated.
gt; But the identical code works fine for the first two ranges??

--

Dave Peterson

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

arrow
arrow
    全站熱搜
    創作者介紹
    創作者 software 的頭像
    software

    software

    software 發表在 痞客邦 留言(0) 人氣()