More than 3 Conditional Formats with VBA - Not Working

[Kris_Wright_77]

Hi
Hope someone can help, as I seem to have got myself stuck.

I am currently trying to Conditionally Format a cell based on 4 conditions.
From code I have found on other posts, I have got most of it working.
However, the bit that doesnt work is the most important bit - Applying the
Format !!

Code is posted below.
As you can see the code is triggered by a change in value on the worksheet.
However, the cell I want formated is relative to the changed cell, and is the
main way in which it has been modified from the other helpful posts. But I
cannot see why this would prevent it working.

Could someone please let me know how to fix it? - I would like to avoid
loading in add-ins etc, as the finished spreadsheet will be used by many
people.
And, if possible, explain why the error is occurring so I can try and avoid
doing it again for a.n.other problem I have to solve/automate.

Thanks very much for any help you can give

Kris

===================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim ProbImpact_rng As Range
Dim ScoreOffset As Integer
Dim vRngInput As Variant

On Error GoTo endit
Select Case Target.Column
Case Is = Range("tbl_Orig_CostProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_CostProb")
ScoreOffset = 2
Case Is = Range("tbl_Orig_CostImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_CostImpact")
ScoreOffset = 1
Case Is = Range("tbl_Orig_ProgProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_ProgProb")
ScoreOffset = 2
Case Is = Range("tbl_Orig_ProgImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_ProgImpact")
ScoreOffset = 1
Case Is = Range("tbl_Resid_CostProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_CostProb")
ScoreOffset = 2
Case Is = Range("tbl_Resid_CostImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_CostImpact")
ScoreOffset = 1
Case Is = Range("tbl_Resid_ProgProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_ProgProb")
ScoreOffset = 2
Case Is = Range("tbl_Resid_ProgImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_ProgImpact")
ScoreOffset = 1
End Select

'Check Target Cell is in a Defined Range _
and not just the same column
Set vRngInput = Intersect(Target, ProbImpact_rng)
If vRngInput Is Nothing Then Exit Sub

Application.EnableEvents = False
'Determine the color
Select Case Target.Offset(0, ScoreOffset).Value
Case Is > 39
Num = 16 'black
Case Is > 20
Num = 3 'red
Case Is > 9
Num = 36 'yellow
Case Is > 0
Num = 34 'green
End Select
'Apply the color
Target.Offset(0, ScoreOffset).Interior.ColorIndex = Num
endit:
Application.EnableEvents = True
End Sub

 

[JE McGimpsey]

If everything works *except* applying the format, my best guess is that
you have Conditional Formatting applied to the cells which is masking
your format.

If that's not the case, I think you need to give more information. When
you set a breakpoint on the line that applies the format, does the
routine stop there (or does it exit before that)? Is ScoreOffset what
you expect it to be? Num?

Note that you don't really need to turn off events- applying formats
doesn't trigger an event. Doesn't hurt, but doesn't help either.

 

[Kris_Wright_77]

I've double and triple checked, and the Conditional Formats show nothing
applied.
In a much earlier version, I had used conditional formatting, but this newer
one needs more, so I deleted them. Is there any possibility that it is still
there?

When I run it line by line everything appears to work fine with the
ScoreOffset and Num taking on the appropriate values.
At the line
Target.Offset(0, ScoreOffset).Interior.ColorIndex = Num
when I hover over it, I get
Target.Offset(0, ScoreOffset).Interior.ColorIndex = -4142
and Num still reads the right value.

After running the line, hovering over
Target.Offset(0, ScoreOffset).Interior.ColorIndex
still gives -4142

I am at a loss.

Is there any other info that I can give that could pinpoint the fault?

Thanks very much

Kris

 

[Tom Ogilvy]

It worked OK for me. Try commenting out your error handler. If one of
your defined ranges does not exist, it will not work. Commenting out the
'On Error GoTo endit

will tell you if this is a problem.

 

[Kris_Wright_77]

Tom

I took out the error handler and it still didnt apply the formatting.

Would it make a difference if the ranges are volatile?

The Named Range "tbl_Orig_CostImpact" is specified as
=OFFSET(tbl_Orig_CostImpact_Hdr,1,0):OFFSET(tbl_Orig_CostImpact_Btm,-1,0)
but the _Hdr and _Btm are both equal to a single cell each.

I have noticed that on some occassions when I have been running the code
line by line, the UDF that I have, which runs after the Worksheet_Change
returns #Name
Does this help identify the problem?

Also, to make absolutely sure that it is not some Conditional Formatting
hanging around from the earlier version, is there a piece of code that
returns whether a cell has Conditional Formatting?

Thanks very much for your help on this.

Kris

 

[Tom Ogilvy]

Edit=>goto=>Special and select conditional formats

If it doesn't raise an error, I would expect it to work

You should put in a msgbox after you have established the situation

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim ProbImpact_rng As Range
Dim ScoreOffset As Integer
Dim vRngInput As Variant

'On Error GoTo endit
Select Case Target.Column
Case Is = Range("tbl_Orig_CostProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_CostProb")
ScoreOffset = 2
Case Is = Range("tbl_Orig_CostImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_CostImpact")
ScoreOffset = 1
Case Is = Range("tbl_Orig_ProgProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_ProgProb")
ScoreOffset = 2
Case Is = Range("tbl_Orig_ProgImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Orig_ProgImpact")
ScoreOffset = 1
Case Is = Range("tbl_Resid_CostProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_CostProb")
ScoreOffset = 2
Case Is = Range("tbl_Resid_CostImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_CostImpact")
ScoreOffset = 1
Case Is = Range("tbl_Resid_ProgProb_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_ProgProb")
ScoreOffset = 2
Case Is = Range("tbl_Resid_ProgImpact_Hdr").Column
Set ProbImpact_rng = Range("tbl_Resid_ProgImpact")
ScoreOffset = 1
End Select
msgbox Target.Address & " " & ProbImpact_rng.Address & " " &
'Check Target Cell is in a Defined Range _
and not just the same column
Set vRngInput = Intersect(Target, ProbImpact_rng)
If vRngInput Is Nothing Then Exit Sub

Application.EnableEvents = False
'Determine the color
Select Case Target.Offset(0, ScoreOffset).Value
Case Is > 39
Num = 16 'black
Case Is > 20
Num = 3 'red
Case Is > 9
Num = 36 'yellow
Case Is > 0
Num = 34 'green
End Select
'Apply the color
msgbox Target.Address & " " & ProbImpact_rng.Address & " " & _
vRngInput.Address & " " & scoreoffset & _
" " & Target.offset(0,ScoreOffset).Value & _
" " & num


Target.Offset(0, ScoreOffset).Interior.ColorIndex = Num
endit:
Application.EnableEvents = True
End Sub

If you don't get the message, then start walking up your code with other
msgboxes to see where it stops working. I say use msgboxes because as I
recall you said stepping through the code wasn't showing you anything.

 

[Kris_Wright_77]

Tom

Used the GoTo special to re-check I have removed previous Conditional
Formats, and got "No Cells were found." message.

So I added the message boxes as you suggested and all of them gave the
correct and consistent results.

The code has always run from start to finish.
It just does not apply the colour to the interior.

I have run a test sub, which just has a single line to apply the colour,
with Target swithced for ActiveCell, ScoreOffset for 2 and Num for Colour
yellow.
ActiveCell.Offset(0, 2).Interior.ColorIndex = 36
And it works correctly.
I therefore guess it has something to do with Target - does it need to be
Dim -ed as something other than Range??

If not, the only thing I can think of now is to recreate the spreadsheet
from scratch, or make a copy and slowly take out the volatile ranges until it
works or not. Although I dont expect this to do anything.

Would the version of Excel make any difference?
I have Excel 2002 - does any part of the code relate specificaaly to another
version?

Thanks for your help & hopefully we will get to the bottom of this.

Kris

 

[Tom Ogilvy]

If the message boxes all gave the correct and consistent results, then it
shouldn't be the ranges - the message boxes demonstrate that the ranges are
being interpreted correctly.

Target is definded by the Change events (you should have selected that from
the dropdown to get the initial function declaration). So it is dimmed as a
range and that is correct. (plus the msgbox should have shown it was
correct).

I can volunteer to take a look at it if you want to send the workbook to me:

(e-mail address removed)

I didn't see anything that was version specific.

--
regards,
Tom Ogivy

 

[Kris_Wright_77]

Tom very kindly looked at the spreadsheet for me.

Unfortunately, he identified a strange interaction between the code for
formatting and the UDF.
Both pieces of VBA run perfectly provided that the other is "switched off",
and unfortunately this cannot be achieved by adding code to conditionally
exit either the Formatting or UDF.

Tom provided a work around which involves making the workbook calculate
manually, but is not an ideal solution.

Should anyone have any experience of similar problems, I would love to know.

Kris

 

[Peter T]

Sounds curious!

Could you explain, or if it's complicated I'd also be interested to see your
workbook.

Regards,
Peter T
pmbthornton gmail com