More than 3 Conditional Formats

K

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top