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

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" <(E-Mail Removed)> wrote in message
news:6A8D610E-3FFA-4F4E-A880-(E-Mail Removed)...
> 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
>
>

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" <(E-Mail Removed)> wrote in message
> news:6A8D610E-3FFA-4F4E-A880-(E-Mail Removed)...
> > 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
> >
> >
>
>
>

> 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" <(E-Mail Removed)> wrote in message
news:E624CD54-7912-48DA-8CF3-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> > news:6A8D610E-3FFA-4F4E-A880-(E-Mail Removed)...
> > > 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
> > >
> > >
> >
> >
> >

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" <(E-Mail Removed)> wrote in message
> news:E624CD54-7912-48DA-8CF3-(E-Mail Removed)...
> > 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" <(E-Mail Removed)> wrote in message
> > > news:6A8D610E-3FFA-4F4E-A880-(E-Mail Removed)...
> > > > 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
> > > >
> > > >
> > >
> > >
> > >
>
>
>

> 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" <(E-Mail Removed)> wrote in message
news:BD233DF9-DCC7-407F-8F33-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> > news:E624CD54-7912-48DA-8CF3-(E-Mail Removed)...
> > > 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" <(E-Mail Removed)> wrote in message
> > > > news:6A8D610E-3FFA-4F4E-A880-(E-Mail Removed)...
> > > > > 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
> > > > >
> > > > >
> > > >
> > > >
> > > >
> >
> >
> >

> 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
news:(E-Mail Removed)...
> > 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
>
>

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
> news:(E-Mail Removed)...
> > > 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
> >
> >
>
>
>