Who can find the solution
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 10 of 10

Thread: Who can find the solution

  1. #1
    Board Regular
    Join Date
    Mar 2002
    Posts
    1,451
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

     
    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. #2
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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.
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  3. #3
    MrExcel MVP Mark O'Brien's Avatar
    Join Date
    Feb 2002
    Location
    Columbus, OH, USA
    Posts
    3,530
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #4
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #5
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Mark,

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

  6. #6
    Board Regular
    Join Date
    Mar 2002
    Posts
    1,451
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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)

  7. #7
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #8
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Oops! By the row!

  9. #9
    Board Regular
    Join Date
    Mar 2002
    Posts
    1,451
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #10
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    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

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

 
DMCA.com