Need help with row color

[parteegolfer]

I have entered the following and the row will not change to default
color when $A(whatever) is not equal to "Weekly Subtotal". It does
change to orange when "Weekly Subtotal" is entered into a cell but wont
change back to excel default color if cell is changed back to "". What
am i doing wrong!

Private Sub Workbook_Open()
Dim cell As Range, rng As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
For Each cell In Sh.Range("AL6:AL2000")
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(Sh.Range("A8:J2000"), _
cell.EntireRow)
rng.Interior.ColorIndex = 45
If cell.Value = "" Then
Set rng = Intersect(Sh.Range("A8:J2000"), _
cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If
End If
Next
Next

 

[Guest]

Your endif is in the wrong place. The if code is only reached if the cell
value is Weekly Subtotal. If it is not then the whole this is skipped. Try
this...

Private Sub Workbook_Open()
Dim cell As Range, rng As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
For Each cell In Sh.Range("AL6:AL2000")
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(Sh.Range("A8:J2000"), _
cell.EntireRow)
rng.Interior.ColorIndex = 45

end if

If cell.Value = "" Then
Set rng = Intersect(Sh.Range("A8:J2000"), _
cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If
Next
Next

 

[Dave Peterson]

Looking at the code nicely indented gives a hint:

Private Sub Workbook_Open()
Dim cell As Range, rng As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
For Each cell In Sh.Range("AL6:AL2000")
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(Sh.Range("A8:J2000"), cell.EntireRow)
rng.Interior.ColorIndex = 45
If cell.Value = "" Then
Set rng = Intersect(Sh.Range("A8:J2000"), cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If
End If
Next cell
Next sh
End sub

Actually, after indenting the code, it make it easier to see the problem.

You're checking to see if the value = "", but you're already in the "Then"
portion of the "if cell.value = "Weekly Subtotal".

You could fix your problem moving the "end if" or using an Else statement.

Private Sub Workbook_Open()
Dim cell As Range, rng As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
For Each cell In Sh.Range("AL6:AL2000")
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(Sh.Range("A8:J2000"), cell.EntireRow)
rng.Interior.ColorIndex = 45
else
If cell.Value = "" Then
Set rng = Intersect(Sh.Range("A8:J2000"), cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If
End If
Next cell
Next sh
End sub

========
An alternative (if you're only using two colors (xlnone and 45).

Change everything to xlnone and just color the cells you want:

Private Sub Workbook_Open()
Dim cell As Range, rng As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Sh.Range("A8:J2000").interior.colorindex = xlnone
For Each cell In Sh.Range("AL6:AL2000")
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(Sh.Range("A8:J2000"), cell.EntireRow)
rng.Interior.ColorIndex = 45
End If
Next cell
Next sh
End sub

And one more alternative. If you're not using format|conditional formatting,
you may want to use it for these areas.

 

[parteegolfer]

Jim,

I entered this just like you suggested and I get the following error:

"OBJECT VARIABLE or WITH BLOCK NOT SET"

Not Sure what this means

 

[Tom Ogilvy]

Change

("AL6:AL2000")

to

("AL8:AL2000")

in both cases.

--
Regards,
Tom Ogilvy

"parteegolfer" <[email protected]>
wrote in message
news[email protected]...

 

[parteegolfer]

Thanks Guys,

This works well!!!!

 

[Gary Keramidas]

as tom mentioned, your ranges are different. maybe do something like this, use
rng1 to set the range:

Option Explicit
Private Sub Workbook_Open()
Dim cell As Range, rng As Range, rng1 As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Set rng1 = Sh.Range("AL6:AL2000")

For Each cell In rng1
If cell.Value = "Weekly Subtotal" Then
Set rng = Intersect(rng1, _
cell.EntireRow)
rng.Interior.ColorIndex = 45

End If

If cell.Value = "" Then
Set rng = Intersect(rng1, _
cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If
Next
Next


End Sub

 

[Gary Keramidas]

here's a little different approach

Private Sub Workbook_Open()
Dim cell As Range, rng As Range, rng1 As Range
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
Set rng1 = Sh.Range("AL6:AL2000")
For Each cell In rng1
With cell
If .Value = "Weekly Subtotal" Then
Set rng = Intersect(rng1, cell.EntireRow)
rng.Interior.ColorIndex = 45
End If

If .Value = "" Then
Set rng = Intersect(rng1, cell.EntireRow)
rng.Interior.ColorIndex = xlNone
End If

End With

Next cell
Next Sh
End Sub

 

[Tom Ogilvy]

Your intersecting cell with its own column (no reason to do that) and
ignoring the range A8:J2000