Forum Discussion
Solved
Color change with new values
Hi.
I'm trying format my sheet so that it changes color every time a line with a new value is reached. The table I'm working with will have a random number of lines with the same value in column a as seen below. I would like a new fill color each time a new value is reached, it can be alternating colors or scale I'm not picky.
Hopefully some can help with that.
Sub color() Dim i As Double Dim k As Integer Dim MaxRow As Double Range("A:A").Interior.ColorIndex = xlNone MaxRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To MaxRow If Cells(i, 1).Value = Cells(i + 1, 1).Value Then Cells(i, 1).Interior.ColorIndex = 4 + k Cells(i + 1, 1).Interior.ColorIndex = 4 + k Else k = k + 1 If k = 50 Then k = 4 Else End If If Cells(i + 1, 1).Value = "" Then Else Cells(i + 1, 1).Interior.ColorIndex = 4 + k End If End If Next i End SubSorry for the mistake. In the attached file i've tested the code for more than 40000 rows and it should work now.
Meanwhile you've already received two easier solutions from HansVogelaar .
Sub color() Dim i As Integer Dim k As Integer Dim MaxRow As Integer Range("A:A").Interior.ColorIndex = xlNone MaxRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 3 To MaxRow If Cells(i, 1).Value = Cells(i + 1, 1).Value Then Cells(i, 1).Interior.ColorIndex = 4 + k Cells(i + 1, 1).Interior.ColorIndex = 4 + k Else k = k + 1 If k = 60 Then k = 4 Else End If If Cells(i + 1, 1).Value = "" Then Else Cells(i + 1, 1).Interior.ColorIndex = 4 + k End If End If Next i End SubMaybe with this code. In the attached file you can click the button in cell C2 to start the macro.
Thank you, this is exactly what I'm looking for. Unfortunately the macro has an error, I'm a completed noob in this so I couldn't fix it my self. Would you mind having a second look at it to see if you can fix it?
Sub color() Dim i As Double Dim k As Integer Dim MaxRow As Double Range("A:A").Interior.ColorIndex = xlNone MaxRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To MaxRow If Cells(i, 1).Value = Cells(i + 1, 1).Value Then Cells(i, 1).Interior.ColorIndex = 4 + k Cells(i + 1, 1).Interior.ColorIndex = 4 + k Else k = k + 1 If k = 50 Then k = 4 Else End If If Cells(i + 1, 1).Value = "" Then Else Cells(i + 1, 1).Interior.ColorIndex = 4 + k End If End If Next i End SubSorry for the mistake. In the attached file i've tested the code for more than 40000 rows and it should work now.
Meanwhile you've already received two easier solutions from HansVogelaar .
