View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default david mcritchie row color please help

In case David McRitchie is not watching -

Sub ColorRowBasedOnCellValue2()
'David McRitchie, 2001-01-17 programming -- Color row based on value
' Application.ScreenUpdating = False
' Application.Calculation = xlCalculationManual
Dim idx As Long
Dim bUpdate As Boolean
Dim v
Dim cell As Range
For Each cell In Intersect(ActiveCell.EntireColumn, _
ActiveSheet.UsedRange)
v = cell.EntireRow.Interior.ColorIndex
Select Case cell.Value
Case Is = 51311: idx = 20
Case Is = 51010: idx = 37
Case Is = 51020: idx = 38
Case Is = 51030: idx = 36
Case Else: idx = 44
End Select
If IsNull(v) Then
bUpdate = True
Else
bUpdate = v < idx
End If
If bUpdate Then
cell.EntireRow.Interior.ColorIndex = idx
End If

Next cell
'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

You don't need to change Calculation. If only a few rows are likely to need
updating no need to disable screenupdating (modified routine only re-colours
if necessary).

If you know the column that always contains your account numbers this could
be easily adpted in a worksheet change event to update format changes occur
automatically

Regards,
Peter T

"michelle" wrote in message
...
Hi I was using the follow macro from your website and changed the values

to
correspond to the values I want highlighted. It doesn't seem to work. Do

I
need to change something in the"(selection, activecell.entirecolum_..."
section?

What I am trying to do is the following....I have about 40 different

account
numbers that if present in the cell, the entire row should be highlighted.

I
don't believe conditional formatting can handle this. That is why I

thought
the following macro would be beneficial. Please help.

Sub ColorRowBasedOnCellValue()
'David McRitchie, 2001-01-17 programming -- Color row based on value
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
For Each cell In Intersect(Selection, ActiveCell.EntireColumn, _
ActiveSheet.UsedRange)
Select Case cell.Value
Case Is = 51311
cell.EntireRow.Interior.colorindex = 20
Case Is = 51010
cell.EntireRow.Interior.colorindex = 37
Case Is = 51020
cell.EntireRow.Interior.colorindex = 38
Case Is = 51030
cell.EntireRow.Interior.colorindex = 36
Case Else
cell.EntireRow.Interior.colorindex = 44
End Select
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub