Alternating Cell Color based off ID Number

[Bhoyle1]

Hi,

I want to base alternating colors off the value in one column. For example below when ID changes the color alternates. This will make it much easier to know when a record changes when scrolling through a list with may rows and columns and the ID may not be in view.


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]ID[/TD]
[TD]Status[/TD]
[/TR]
[TR]
[TD]111[/TD]
[TD]New
[/TD]
[/TR]
[TR]
[TD]111[/TD]
[TD]New[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Old[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Old[/TD]
[/TR]
[TR]
[TD]333[/TD]
[TD]New[/TD]
[/TR]
[TR]
[TD]333[/TD]
[TD]New[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this. !!!

[COLOR="Navy"]Sub[/COLOR] MG27Aug44
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
Rows(2).Font.Color = vbBlue
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
col = Dn.Offset(-1).Font.Color
    [COLOR="Navy"]If[/COLOR] Dn.Offset(-1).Value = Dn.Value [COLOR="Navy"]Then[/COLOR]
        Dn.EntireRow.Font.Color = col
    [COLOR="Navy"]Else[/COLOR]
        Dn.EntireRow.Font.Color = IIf(col = vbBlue, vbBlack, vbBlue)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Peter_SSs]

Here is a dynamic way using Conditional Formatting that you could also consider.

 

[Zenwood]

Try this.

Sub RowColor_26()


' -------------------------------------------------------------------------------------------------------------------------------------
'    This will color rows in groups based on data the matched in a certain column
'    by Zenwood 6.13.18
'    Users are asked to update variables
' -------------------------------------------------------------------------------------------------------------------------------------


'       Compare items in this column
Dim Compare As String
Compare = InputBox(vbCr & "   What column are we sorting on?" & vbCr & vbCr & "   Press Return for default values", , "A")


'       Find the end of this column
Dim HomeColumn As String
HomeColumn = InputBox(vbCr & "   Look to the end of what column?", , "A")


'       Start with this row
Dim Row As Integer: Row = 2
Row = InputBox(vbCr & "   What row to start with?", , "2")




'       Color across from this column
Dim ColumnStart As String
ColumnStart = InputBox(vbCr & "   Start column?", , "A")


'       Stop coloring across at this column
Dim ColumnEnd As String
ColumnEnd = InputBox(vbCr & "   End column?", , "R")


' -------------------------------------------------------------------------------------------------------------------------------------


'       Start with this much Red
Dim Red As Integer
Red = InputBox(vbCr & "   How much Red?" & vbCr & vbCr & "   200 - 255", , "210")




'       Start with this much Green
Dim Green As Integer
Green = InputBox(vbCr & "   How much Green?" & vbCr & vbCr & "   200 - 255", , "250")




'       Start with this much Blue
Dim Blue As Integer
Blue = InputBox(vbCr & "   How much Blue?" & vbCr & vbCr & "   200 - 255", , "210")




' -------------------------------------------------------------------------------------------------------------------------------------


'       Change Red by... not zero
Dim NewRed As Integer
NewRed = InputBox(vbCr & "   How much Red to add?" & vbCr & vbCr & "   +/- 50", , "1")
If NewRed = 0 Then NewRed = 1


'       Change Green by...
Dim NewGreen As Integer
NewGreen = InputBox(vbCr & "   How much Green to add?" & vbCr & vbCr & "   +/- 50", , "0")


'       Change Blue by...
Dim NewBlue As Integer
NewBlue = InputBox(vbCr & "   How much Blue to add?" & vbCr & vbCr & "   +/- 50", , "40")


Dim BaseRed As Integer: BaseRed = Red


' -------------------------------------------------------------------------------------------------------------------------------------


          Do While (Cells(Row, HomeColumn) <> "")
          
                    If (Cells(Row, Compare) <> "") And (Cells(Row - 1, Compare) = Cells(Row, Compare)) Then
                    Red = Red
                    Else
                    
                              If Red = BaseRed Then
                              Red = Red + NewRed
                              Green = Green + NewGreen
                              Blue = Blue + NewBlue
                              
                              Else
                              Red = Red - NewRed
                              Green = Green - NewGreen
                              Blue = Blue - NewBlue
                              End If
                    
                    End If
          
          Range(ColumnStart & Row, ColumnEnd & Row).Interior.Color = RGB(Red, Green, Blue)
          
          Row = Row + 1
          
          Loop
          
' -------------------------------------------------------------------------------------------------------------------------------------


End Sub