Conditonal Formatting VB Code?

[RonS]

I've been able to created the following VB code, but it takes almost 30 seconds or more to run when the worksheet is activated. I need to know if there is a better way or place to run the code? It would be great if I could get it to run whenever a cell value is changed to Red, Blue, Green, or Amber. I want to use this in a spreadsheet for project milestones ranked as RAG or Blue that are imported from a MS Project Plan file. I've tried to use the same code with another module, Private Sub Worksheet_Calculate(), but it still takes to long to run. What is the fastest way that I can make this code run?

Private Sub Worksheet_Activate()

Dim oCell As Range

For Each oCell In Range("N17:N151")
Select Case oCell.Value
Case "Red"
oCell.Interior.ColorIndex = 3
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Blue"
oCell.Interior.ColorIndex = 5
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
Case "Green"
oCell.Interior.ColorIndex = 4
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Amber"
oCell.Interior.ColorIndex = 6
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Complete"
oCell.Interior.ColorIndex = 1
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
End Select
Next oCell

For Each oCell In Range("BF261:BF276")
Select Case oCell.Value
Case "Red"
oCell.Interior.ColorIndex = 3
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Blue"
oCell.Interior.ColorIndex = 5
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
Case "Green"
oCell.Interior.ColorIndex = 4
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Amber"
oCell.Interior.ColorIndex = 6
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Complete"
oCell.Interior.ColorIndex = 1
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
End Select
Next oCell

End Sub

 

[Tom Ogilvy]

I believe that is about as fast as you are going to get since you need to
examine the value of each of the cells and format them according to that
value.

That said, I would expect it to be almost instantaneous based on the few
number of cells being examined. It runs instantly on my computer (once it
runs once) (about 900 Mhz). Generally, setting a cell to bold is very
slow the first time you do it in an instance of Excel. I assume it has
something to do with loading the font information. After the first time,
then there is no delay. Since your code is using bold, this could be part
of the problem.

That said, if each of the cells of interest will have one of the four
values, you can use conditional formatting. It only handles 3 conditions,
but you can set the formatting of the fourth condition as the default.

--
Regards,
Tom Ogilvy

I've been able to created the following VB code, but it takes almost 30

seconds or more to run when the worksheet is activated. I need to know if
there is a better way or place to run the code? It would be great if I
could get it to run whenever a cell value is changed to Red, Blue, Green, or
Amber. I want to use this in a spreadsheet for project milestones ranked as
RAG or Blue that are imported from a MS Project Plan file. I've tried to
use the same code with another module, Private Sub Worksheet_Calculate(),
but it still takes to long to run. What is the fastest way that I can make
this code run?

 

[RonS]

To

Is there a way to do this a single cell at a time using the change event, for multiple columns

similar to this

Private Sub Worksheet_Change(ByVal Target As Range

Dim oCell As Rang

For Each oCell In Intersect(Columns("N"), ActiveSheet.UsedRange
Select Case oCell.Valu
Case "Red
oCell.Interior.ColorIndex =
oCell.Font.ColorIndex =
oCell.Font.Bold = Tru
Case "Blue
oCell.Interior.ColorIndex =
oCell.Font.ColorIndex =
oCell.Font.Bold = Tru
Case "Green
oCell.Interior.ColorIndex =
oCell.Font.ColorIndex =
oCell.Font.Bold = Tru
Case "Amber
oCell.Interior.ColorIndex =
oCell.Font.ColorIndex =
oCell.Font.Bold = Tru
Case "Complete
oCell.Interior.ColorIndex =
oCell.Font.ColorIndex =
oCell.Font.Bold = Tru
End Selec
Next oCel

End Sub

 

[Tom Ogilvy]

I don't see any reason to change all cells in N if only one cell has
changed - I assume that is really what you want:

Private Sub Worksheet_Change(ByVal Target As Range)
if Target.count > 1 then exit sub
Dim oCell As Range
if Target.Column = 14 then
set oCell = Target

Select Case oCell.Value
Case "Red"
oCell.Interior.ColorIndex = 3
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Blue"
oCell.Interior.ColorIndex = 5
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
Case "Green"
oCell.Interior.ColorIndex = 4
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Amber"
oCell.Interior.ColorIndex = 6
oCell.Font.ColorIndex = 1
oCell.Font.Bold = True
Case "Complete"
oCell.Interior.ColorIndex = 1
oCell.Font.ColorIndex = 2
oCell.Font.Bold = True
End Select
End if

End Sub

 

[Bob Phillips]

Ron,

Try This


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo ws_exit
If Not Intersect(Target, Range("N7:N151")) Is Nothing Then
With Target
Select Case .Value
Case "Red"
.Interior.ColorIndex = 3
.Font.ColorIndex = 1
.Font.Bold = True
Case "Blue"
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.Font.Bold = True
Case "Green"
.Interior.ColorIndex = 4
.Font.ColorIndex = 1
.Font.Bold = True
Case "Amber"
.Interior.ColorIndex = 6
.Font.ColorIndex = 1
.Font.Bold = True
Case "Complete"
.Interior.ColorIndex = 1
.Font.ColorIndex = 2
.Font.Bold = True
End Select
End With
End If

ws_exit:
Application.EnableEvents = True

End Sub


End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)