Who can find the solution

[verluc]

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.

[Al Chara]

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.

[Mark O'Brien]

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.

[Jay Petrulis]

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

[Al Chara]

Mark,

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

[verluc]

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.
Thanks in advance.
(P.S.My numbers are in the range D5:Z5000)

[Tom Schreiner]

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 ]

[Tom Schreiner]

Oops! By the row!

[verluc]

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

[Tom Schreiner]

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


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