Thread: Cells with same value, rows with same color. Uneven list

Is it eventually possible?
Thanks

check this

Sub a()
Dim col
col = Array(15, 48) 'color indexes
Dim r As Integer 'row index
Dim c As Integer 'colour index
Dim check As String 'checking value

r = 3
c = 0

check = Cells(r, 3).Value
Do Until Cells(r, 3).Value = ""
 If Cells(r, 3).Value <> check Then
  c = c + 1
  check = Cells(r, 3).Value
 End If
  
 Rows(r & ":" & r).Interior.ColorIndex = col(c Mod 2) 'set row interior colour
 
 r = r + 1
Loop
End Sub

Best Regards
MaczaQ

Originally Posted by maczaq

check this

I am sorry but that doesn't seem to work the colors changes not for every entry, also i need to insert the value of the last cell, and i need it be automatic as the macro it is applied by an external app.
I post here a code a found which divide every entry with border, maybe from that will be possible to construct a color code:

    Set rRange = Range("A3", Range("A65536").End(xlUp))
        For Each rCell In rRange
        If Not IsEmpty(rCell) And _
           Not IsEmpty(rCell.Offset(1, 0)) Then
            With rCell
                If .Value <> .Offset(1, 0).Value Then
                   With .Resize(1, 18).Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                End With
                End If
            End With
        End If
    Next rCell

Thank you very much for your attention!

I'm a bit confused because I think this code works in way you want.

Please check attached example. Now is sensitive for changes in Sheet1

Best Regards

Originally Posted by maczaq

I'm a bit confused because I think this code works in way you want.

Please check attached example. Now is sensitive for changes in Sheet1

Best Regards

It's very strange because on my data doesn't work while it does in the example. Perhaps because in the first column the values are alphanumeric instead of just numbers?

No it is not a reason that you have other formatting of cell because there is simply comparishion of cell value.

(You wrote "first column") - in example first column is "C" and here is part of code testing values in column C:

check = Cells(r, 3).Value 'here 3 is column index
Do Until Cells(r, 3).Value = "" 'and here
 If Cells(r, 3).Value <> check Then 'and here
  c = c + 1
  check = Cells(r, 3).Value 'and here

make sure that your "first column" is C or change that 3 into correct column index and should work with your data.

Best Regards