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
|