Fill Cells With Colors When A Value Changes

[hrayani]

Hi All,

I am using the below code to create partition / applying borders in range A4:L4 down till the last non empty cell whenever a value changes in Column B.

[COLOR=#333333]Sub Test()      [/COLOR]    
Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("B4:B" & LastRow)
        If rng <> rng.Offset(1, 0) Then
            Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Range("A" & rng.Row & ":L" & rng.Row).Borders(xlEdgeBottom).Weight = xlMedium
            
        End If
    Next rng
   [COLOR=#333333]End Sub[/COLOR]

What i want is a code to fill colors in cells where the code is creating partition / applying borders.

For example:

2
2 This partition to turn color 1
2 _______________________
3
3 This partition to turn color 2
3 ______________________
4 ______________________This partition to turn color 1
5
5 This partition to turn color 2
5 ______________________
6
6 This partition to turn color 1
6 ______________________


The data is not constant so i run the code everytime the data changes.
The borders are created with the code mentioned above. I would want the code to fill colors also.
An addition or ammendment in the current code or a new code would do.

Any help would be appreciated.

Regards,

 

[James006]

Hi,

Could you describe what you exactly have

1. In cell A1

2. In the range A4:A50

The macro you have found relies on these cells to operate ...

 

[James006]

Hi,

Just wondering ... if you have fix your problem ...???

 

[hrayani]

Hi,

James i don't have access to my computer...

Will get back to you as soon as i am on my computer

Regards,

Humayun

 

[James006]

No problem ...

 

[hrayani]

Hi james,

Below is the last code about which i told you that its not working. Like its coloring every other row regardless of the value change.

[COLOR=#333333]Sub Colorize2()[/COLOR]Dim r As Long, val As Long, c As Long


    r = 1
    val = ActiveSheet.Cells(r, 1).Value
    c = 4                                  '4 is green ,  3 is red '


    For r = 4 To ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
        If ActiveSheet.Cells(r, 2).Value <> val Then
            If c = 3 Then
                c = 4
            Else
                c = 3
            End If
        End If


        ActiveSheet.Range("A" & r & ":L" & r).Select
        With Selection.Interior
            .ColorIndex = c
            .Pattern = xlSolid
        End With
        val = ActiveSheet.Cells(r, 1).Value
    Next r [COLOR=#333333] End Sub[/COLOR]

I just change these part of the code

r = 1 to r=2
val = ActiveSheet.Cells(r, 1).Value to val = ActiveSheet.Cells(r, 2).Value
val = ActiveSheet.Cells(r, 1).Value to val = ActiveSheet.Cells(r, 2).Value

Now the code is working just perfect

 

[James006]

Glad you could fix your problem ...