david mcritchie row color please help
 

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

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

david mcritchie row color please help
 

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" wrote:

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

david mcritchie row color please help
 

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" wrote in message
...
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" wrote:

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

david mcritchie row color please help
 

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" wrote:

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" wrote in message
...
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" wrote:

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

david mcritchie row color please help
 

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


"michelle" wrote in message
...
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" wrote:

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" wrote in message
...
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" wrote:

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

david mcritchie row color please help
 

Case Is = 51311: idx = 20

I blindly copied the original, simply

Case 51311: idx = 20

Peter T

"Peter T" <peter_t@discussions wrote in message
...
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

david mcritchie row color please help
 

Thank you so much for your help. It worked.

"Peter T" wrote:

Case Is = 51311: idx = 20

I blindly copied the original, simply

Case 51311: idx = 20

Peter T

"Peter T" <peter_t@discussions wrote in message
...
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