Who can find the solution

verluc

Well-known Member
Joined
Mar 1, 2002
Messages
1,451
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.
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Mark,

You are right. I missed that part. My code will not do what he wants. (Its been a long day).
 
Upvote 0
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)
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
No I can not.
Am not clear on your instructions.
This message was edited by TsTom on 2002-04-08 17:10
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top