Coloring the Desired cells

[Harsh]

Hello,

I have a work sheet in which i have to look for word "Test" and color
the rows below it.
There are different words like "Test 1" "Test 2" and each set needs a
different color.
Can I get some help with the macro for it?

eg:
Test1
row 1
row 2

Test 2
row 1
row 2

the number of rows in each group is not constanr.


Thank you,
Harsh

 

[Otto Moehrbach]

Excel will need to know the logic of the rows and colors to be able to
determine how many rows to color. You say the number of rows is not
constant, but obviously you know how many rows to color. How do you know
that? HTH Otto

 

[Harsh]

The spread sheet has many parameters. The Test 1 condition repeats and
the number of rows is uncertain . So the logic i was thinking search
Test 1 and color until Test 2 and so on...

 

[Otto Moehrbach]

That sounds good. The code could search for any entry that starts with
"Test" and go from there. Do you have a list of what color goes with what
"Test X"?
Is all your data in one column? What column? If more than one, what
columns to search? Answer these questions and I'll work you up something in
the morning (USA Easter time). HTH Otto

 

[Harsh]

I need to search Test in 2nd column. But the data below test is in
multiple columns.

eg.

Test1
Data1 data2 Data3 data4
Data1 data2 Data3 data4

Test2
Data1 data2 Data3 data4
Data1 data2 Data3 data4

and so on..

The number of columns too are unknown.

Thanks for your help,
Harsh....

 

[Otto Moehrbach]

Is the number of columns constant for all the rows below any given Test X or
does that vary also? Otto

 

[Harsh]

Yes it varies too. and for each Test X the color should be different.

Test 1 red,
test 2 blue
test 3 green

and thee 3 test conditions repeat in the sheet. Both rows and columns
are not constant.
Thanks.

 

[Otto Moehrbach]

Harsh
Try this out and see if it does what you want. Paste all the following
code into a regular module. Run this code when the sheet that has all the
Test data is the active sheet. If you wish, send me an email and I'll send
you the small file I used to develop this code. My email address is
(e-mail address removed). Remove the "nop" from this address. HTH Otto

Option Explicit
Dim RngColB As Range, First As Range, Last As Range
Dim RngToColor As Range, i As Range, LastRow As Long
Dim c As Long, ColorNum As Long

Sub ColorTests()
Call FindFirstTest
Call ColorData
End Sub

Sub FindFirstTest()
'Find first instance of "Test"
Set RngColB = Range("B2", Range("B" & Rows.Count).End(xlUp))
LastRow = RngColB(RngColB.Count).Row
Set First = RngColB.Find(What:="Test", _
After:=RngColB(RngColB.Count), _
LookAt:=xlPart, SearchOrder:=xlByColumns)
End Sub

Sub ColorData()
Do
'In case of no data after First
If Left(First.Offset(1), 4) = "Test" Then
Set First = First.Offset(1)
GoTo LoopAgain
End If
Call GetLast
Select Case Right(First, 1)
Case "1": ColorNum = 3
Case "2": ColorNum = 5
Case "3": ColorNum = 4
End Select
Set RngToColor = Range(First.Offset(1), Last)
For Each i In RngToColor
Range(i, Cells(i.Row, Columns.Count).End(xlToLeft)) _
.Interior.ColorIndex = ColorNum
Next i
Set First = Last.Offset(1)
LoopAgain:
Loop Until Last.Row >= LastRow
End Sub

Sub GetLast()
For c = 2 To 1000
If Left(First.Offset(c), 4) = "Test" Then
Set Last = First.Offset(c - 1)
Exit For
Else
If IsEmpty(First.Offset(c).Value) Then
Set Last = First.Offset(c - 1)
Exit For
End If
End If
Next c
End Sub