Thanks:  0
Likes:  0

# Thread: Who can find the solution

1. I have a sheet filled with numbers in the range A1: A5000
Each day I add a column, so afther one day I have also the column B1:B5000,afther two days I have also the column C1:C5000 and so on each further day.
I want to write a macro that does the following:

If there are 5 numbers in a row who are rising ex. 31 , 20, 10, 13, 17,19, 21 then the cells 10/13/17/19/21 must be changed with interiorcolor : 2
If there are 6 numbers : interiorcolor 3
If there are 7 numbers : interiorcolor 4

Is this possible?

Many thanks.

2. If I understand what you want to do, then try the following:

LastRow = Range(Range("A1"), Intersect(Columns(1), ActiveSheet.UsedRange)).Rows.Count
For i = 1 To LastRow
ColumnNum = Range(Range("a" & i), Range("a" & i).End(xlToRight)).Cells.Count
If ColumnNum = 5 Then
Range(Range("a" & i), Intersect(Rows(i), Columns(ColumnNum))).Interior.ColorIndex = 2
ElseIf ColumnNum = 6 Then
Range(Range("a" & i), Intersect(Rows(i), Columns(ColumnNum))).Interior.ColorIndex = 3
ElseIf ColumnNum = 7 Then
Range(Range("a" & i), Intersect(Rows(i), Columns(ColumnNum))).Interior.ColorIndex = 4
End If
Next

Not too clean, but should work. I didn't test it so, post if you have problems.

3. Is there possible confusion over the term "5 numbers in a row"? I took this to mean 5 consecutive numbers that increase as you go down a column and not as you go across the rows.

I wrote a fairly lengthy description of what you will need to do if this is the case, then I got logged out while typing it and lost my reply.

If Al Chara's solution is what is required, great, if not please repost.

4. Hi,

Not sure if Al's solution is correct.

Here is a brute force method, which is not elegant or efficient, but may serve to help others post something better.

---------------------------------
Sub test()
Dim lastcol As Integer, y As Integer
Dim lastrow As Long, x As Long

On Error Resume Next
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For x = 1 To lastrow
For y = 1 To lastcol

If Cells(x, y) < Cells(x, y + 1) And _
Cells(x, y + 1) < Cells(x, y + 2) And _
Cells(x, y + 2) < Cells(x, y + 3) And _
Cells(x, y + 3) < Cells(x, y + 4) And _
Cells(x, y + 4) >= Cells(x, y + 5) _
Then Range(Cells(x, y), Cells(x, y + 4)).Interior.ColorIndex = 10

If Cells(x, y) < Cells(x, y + 1) And _
Cells(x, y + 1) < Cells(x, y + 2) And _
Cells(x, y + 2) < Cells(x, y + 3) And _
Cells(x, y + 3) < Cells(x, y + 4) And _
Cells(x, y + 4) < Cells(x, y + 5) And _
Cells(x, y + 5) >= Cells(x, y + 6) _
Then Range(Cells(x, y), Cells(x, y + 5)).Interior.ColorIndex = 3

If Cells(x, y) < Cells(x, y + 1) And _
Cells(x, y + 1) < Cells(x, y + 2) And _
Cells(x, y + 2) < Cells(x, y + 3) And _
Cells(x, y + 3) < Cells(x, y + 4) And _
Cells(x, y + 4) < Cells(x, y + 5) And _
Cells(x, y + 5) < Cells(x, y + 6) _
Then Range(Cells(x, y), Cells(x, y + 6)).Interior.ColorIndex = 4

Next y
Next x
On Error GoTo 0

End Sub
------------------------------

HTH,
Jay

5. Mark,

You are right. I missed that part. My code will not do what he wants. (Its been a long day).

6. On 2002-04-08 15:36, Mark O'Brien wrote:
Is there possible confusion over the term "5 numbers in a row"? I took this to mean 5 consecutive numbers that increase as you go down a column and not as you go across the rows.

I wrote a fairly lengthy description of what you will need to do if this is the case, then I got logged out while typing it and lost my reply.

If Al Chara's solution is what is required, great, if not please repost.
I mean 5 or more consecutive numbers in the same row and not in the column.
(P.S.My numbers are in the range D5:Z5000)

7. This will work but...

Sub ColorCells()
Dim RowCntr As Long
Dim ColumnCntr As Integer
Dim Color_Range As Byte

ColumnCntr = 1

Do Until Not IsNumeric(Cells(1, ColumnCntr).Value)
For RowCntr = 1 To 5000
Color_Range = 0
If Cells(RowCntr, ColumnCntr).Value < Cells(RowCntr + 1, ColumnCntr).Value And _
Cells(RowCntr + 1, ColumnCntr).Value < Cells(RowCntr + 2, ColumnCntr).Value And _
Cells(RowCntr + 2, ColumnCntr).Value < Cells(RowCntr + 3, ColumnCntr).Value And _
Cells(RowCntr + 3, ColumnCntr).Value < Cells(RowCntr + 4, ColumnCntr).Value Then
Color_Range = 1
If Cells(RowCntr + 4, ColumnCntr).Value < Cells(RowCntr + 5, ColumnCntr).Value Then
Color_Range = 2
If Cells(RowCntr + 5, ColumnCntr).Value < Cells(RowCntr + 6, ColumnCntr).Value Then _
Color_Range = 3
End If
Select Case Color_Range
Case 1
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 4, ColumnCntr)).Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Case 2
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 5, ColumnCntr)).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Case 3
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 6, ColumnCntr)).Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End Select
End If
Next
ColumnCntr = ColumnCntr + 1
Loop

End Sub

What if you have more than 7 in a row?

This macro will do the following.
1,2,3,4,5,6,7,8,9

1,2,3,4,5,6,7 would be set to Color 4
then
2,3,4,5,6,7 would be set to color 3
then
3,4,5,6,7, would be set to color 2

If a set is found, should the search begin at the row immediately following the newly shaded area? Or, as is, the next cell?
You did not specify. Let us know...
Tom

[ This Message was edited by: TsTom on 2002-04-08 16:04 ]

8. Oops! By the row!

9. On 2002-04-08 16:01, TsTom wrote:
This will work but...

Sub ColorCells()
Dim RowCntr As Long
Dim ColumnCntr As Integer
Dim Color_Range As Byte

ColumnCntr = 1

Do Until Not IsNumeric(Cells(1, ColumnCntr).Value)
For RowCntr = 1 To 5000
Color_Range = 0
If Cells(RowCntr, ColumnCntr).Value < Cells(RowCntr + 1, ColumnCntr).Value And _
Cells(RowCntr + 1, ColumnCntr).Value < Cells(RowCntr + 2, ColumnCntr).Value And _
Cells(RowCntr + 2, ColumnCntr).Value < Cells(RowCntr + 3, ColumnCntr).Value And _
Cells(RowCntr + 3, ColumnCntr).Value < Cells(RowCntr + 4, ColumnCntr).Value Then
Color_Range = 1
If Cells(RowCntr + 4, ColumnCntr).Value < Cells(RowCntr + 5, ColumnCntr).Value Then
Color_Range = 2
If Cells(RowCntr + 5, ColumnCntr).Value < Cells(RowCntr + 6, ColumnCntr).Value Then _
Color_Range = 3
End If
Select Case Color_Range
Case 1
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 4, ColumnCntr)).Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Case 2
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 5, ColumnCntr)).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Case 3
With Range(Cells(RowCntr, ColumnCntr), Cells(RowCntr + 6, ColumnCntr)).Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End Select
End If
Next
ColumnCntr = ColumnCntr + 1
Loop

End Sub

What if you have more than 7 in a row?

This macro will do the following.
1,2,3,4,5,6,7,8,9

1,2,3,4,5,6,7 would be set to Color 4
then
2,3,4,5,6,7 would be set to color 3
then
3,4,5,6,7, would be set to color 2

If a set is found, should the search begin at the row immediately following the newly shaded area? Or, as is, the next cell?
You did not specify. Let us know...
Tom

[ This Message was edited by: TsTom on 2002-04-08 16:04 ]
This macro does not work.Perhaps the range is not correct.My numbers are in the range D5:Z5000
If there are more than 7 numbers,there must be an other color untill maximum 10
Can you change your macro,so I can test him.
Thanks

10. No I can not.
Am not clear on your instructions.

[ This Message was edited by: TsTom on 2002-04-08 17:10 ]

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•