Shade rows A:J

[Elaine]

I have an Excel 2002 spreadsheet where there are several records. I would
like to shade certain rows from Col A: Col J where the following occurs: if
current cell has the word total and the cell above has the word total in it,
I would like to shade two rows below current cell (with say green -- code 35).

Thus, if E42 = Book Total and E43 is June Total, I would like to shade A:J
in row 45.

If E42 = Book Total and E43 does not contain total then do nothing.

Tom Ogilvy and Jim Cone helped me in a previous problem similar to this but
I am stumped and don't know how to proceed from the point below. Any help is
really appreciated. Thanks.

Private Sub mcr18Shade()

Dim RngCell As Range
Dim lngCounter As Long

For lngCounter = 1337 To 1 Step -1
Set RngCell = ActiveSheet.Cells(lngCounter, 5) 'Col E

''If current cell in E has word total in it and cell above has total in it
then shade A:J

If RngCell.Value Like "*total*" And _
InStr(1, LCase(RngCell.Offset(-1, 0).Value), "total") > 0 Then

'Shade two rows below green (interior.color=35)
End If
Next
End Sub

 

[Jake Marx]

Hi Elaine,

You could do this with conditional formatting, and it would require no VBA
code. To do it, just follow these steps:

1) select your range (let's say A4:J60)

2) select Format | Conditional Formatting

3) select "Formula Is" and type the following into the textbox:

=AND(SEARCH("total",$E1)>0,SEARCH("total",$E2)>0)

4) click Format... and select the desired format (green pattern)

5) click OK, then OK


Now, a row should be shaded green when the values in column E 2 rows up and
3 rows up contain the string "total".

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

 

[Tom Ogilvy]

Private Sub mcr18Shade()

Dim RngCell As Range
Dim lngCounter As Long

For lngCounter = 1337 To 1 Step -1
Set RngCell = ActiveSheet.Cells(lngCounter, 5) 'Col E

''If current cell in E has word total in it and
''cell above has total in it then shade A:J

if application.Countif(rngCell.offset(-1,0).Resize(2),"*total*) = 2
then
rngCell.offset(2,-4).Resize(1,10).Interior.ColorIndex = 35
End If
Next
End Sub

 

[Jim Thomlinson]

Sorry you wanted 2 rows down from the bottom. My other code is two rows down
from the top. Here is what you need... Sorry

Public Sub Shade()
Dim strFirstAddress As String
Dim rngFound As Range
Dim rngToSearch As Range

Set rngToSearch = ActiveSheet.Range("E1").EntireColumn

Set rngFound = rngToSearch.Find("total", , , xlPart)
If rngFound Is Nothing Then
MsgBox "No areas to shade."
Else
strFirstAddress = rngFound.Address
Do
If rngFound.Offset(1, 0).Value Like "*total*" Then
Range(rngFound.Offset(3, -4), rngFound.Offset(3,
5)).Interior.ColorIndex = 35
End If
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

 

[Jim Thomlinson]

Here is some code that works no matter how many rows of data you have. Tom's
is great, but it doesn't work if you have more than 1337 rows of data.
Depends what you need.

Public Sub Shade()
Dim strFirstAddress As String
Dim rngFound As Range
Dim rngToSearch As Range

Set rngToSearch = ActiveSheet.Range("E1").EntireColumn

Set rngFound = rngToSearch.Find("total", , , xlPart)
If rngFound Is Nothing Then
MsgBox "No areas to shade."
Else
strFirstAddress = rngFound.Address
Do
If rngFound.Offset(1, 0).Value Like "*total*" Then
Range(rngFound.Offset(2, -4), rngFound.Offset(2,
5)).Interior.ColorIndex = 35
End If
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
End Sub

 

[Tom Ogilvy]

Tom's is great, but it doesn't work if you have more than 1337 rows of
data.

Why would that be Jim?

 

[Elaine]

Thank you very much for your reply. I tried all three -- including Jim's
follow up. I was curious about Tom's code though and I was wondering if I had
to have declaration at the top of the module or add something to the library.

Tom's code runs and shades the rows correctly but I get an
Application-defined or Object-Defined error. (Run time error 1004).

This following line is highlighed in yellow and I get the debug dialog box.
If Application.CountIf(RngCell.Offset(-1, 0).Resize(2), "*total*") = 2 Then

When I pass my mouse over the highlighted line it reads:
RngCell.offset(-1,0).Resize(2) = <Application-defined or object-defined error>

Any ideas on what causes this?

I was in cell A6 when I ran the macro.
The only declaration at the top of the module is option compare text.

 

[Tom Ogilvy]

You wrote your code
For lngCounter = 1337 To 1 Step -1

but said:
if current cell has the word total and the cell above has the word total in
it,

so I looked up (from row 100 to row 99) to check for the other cell with
total.

when it reaches 1 in you loop, it can't look up. So you would modify

For lngCounter = 1337 To 2 Step -1

to address Jim's concern, if you have more rows, change 1337 to the number
of rows. That was your design criteria - not mine.

 

[Elaine]

Thanks, Tom. I saw Jim's comment and changed it to 1500. I might at the most
have 1200 records.

Thanks to you and Jim for your help and explanations as well.