david mcritchie row color please help

[michelle]

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

 

[Peter T]

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]

For right now, I have it in column A. I pasted the macro, but it doesn't
work. Why is it? Also is there a way to have a row change color based on a
value in a pivot table using this macro?

 

[Peter T]

For right now, I have it in column A.

It ?

For the code to work your numbers should be in Col-A, then you need to
select a cell in col-A then run the macro. Is that what you are doing.

Regards,
Peter T

 

[michelle]

Sorry, I have the account numbers ("it") in column A.

I got it to work now. Can this same thing be applied to a pivot table?

 

[Peter T]

Can this same thing be applied to a pivot table?

Maybe, but might be problematic

Instead of the macro try the following change event in the worksheet module
(right click the sheet tab > View code).

Test in back-up wb with your pivot table. Not the possibility to enter ## in
any cell to update the whole sheet

' in worksheet module
Dim mbExit As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim idx As Long
Dim bUpdate As Boolean
Dim nCnt As Long
Dim bScrUpdt As Boolean
Dim rng As Range
Dim rCol As Range
Dim cell As Range

If mbExit Then Exit Sub
On Error GoTo errH

'' change A's & the 1 in cells() to appropriate column if not col-A
Set rng = Range("A1:A" & Cells(65536, 1).End(xlUp).Row)
' avoid usedrange unless necessary to minimize loss of undo if no format
change

If Target(1) = "##" Then
' enter ## in any cell to update all rows
mbExit = True
Target(1).Clear
Else
' only look at changed cells(s)
Set rng = Intersect(rng, Target)
End If

If Not rng Is Nothing Then
nCnt = rng.Count

For Each cell In rng
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
b = True
Else
b = v <> idx
End If
If b Then
If nCnt > 1 And Not bScrUpdt Then
Application.ScreenUpdating = False
bScrUpdt = True
End If
cell.EntireRow.Interior.ColorIndex = idx
End If

Next cell
End If

done:
If bScrUpdt Then
Application.ScreenUpdating = True
End If
mbExit = False

Exit Sub
errH:
Resume done
End Sub

Regards,
Peter T

 

[Peter T]

Case Is = 51311: idx = 20

I blindly copied the original, simply

Case 51311: idx = 20

Peter T

 

[michelle]

Thank you so much for your help. It worked.

I blindly copied the original, simply

Case 51311: idx = 20

Peter T