Jun 24 2022 05:27 AM
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.
Jun 25 2022 04:10 AM
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 Sub
Maybe with this code. In the attached file you can click the button in cell C2 to start the macro.
Jun 27 2022 01:19 AM
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?
Jun 27 2022 03:28 AM
How about
Sub color()
Dim i As Integer
Dim k As Integer
Dim MaxRow As Integer
k = 2
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
k = k + 1
If k > 56 Then
k = 3
End If
End If
Cells(i, 1).Interior.ColorIndex = k
Next i
End Sub
or
Sub color()
Dim i As Integer
Dim k As Integer
Dim MaxRow As Integer
k = 3
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
k = 7 - k
End If
Cells(i, 1).Interior.ColorIndex = k
Next i
End Sub
Jun 27 2022 04:01 AM
SolutionSub 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 Sub
Sorry 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 @Hans Vogelaar .
Jun 27 2022 04:06 AM
Jun 27 2022 04:01 AM
SolutionSub 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 Sub
Sorry 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 @Hans Vogelaar .