VBA Colour rows in a range containing data with 2 alternating RGB Colours

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
122
Office Version
  1. 2019
Platform
  1. Windows
Excel 2019
Windows 10

I wish to colour all rows, from Column A - Column G that contains data
using 2 alternaing RGB colours on a specific called Results.

I want to do this using VBA as I am using VBA to pull data from various other
worksheets into the Results sheet.

so...
Row 1 = RGB(179, 230, 255)
Row 2 = RGB(255, 255, 197)
Row 3 =RGB(179, 230, 255)
Row 4 = RGB(255, 255, 197)

and so on down the columns.

I have a existing VBA code (macro) that colours a different sheet based on matching rows but I am struggling
to adapt it to the criteria above.
VBA Code:
Sub ColourAlternateRows()
    With Application
        .ScreenUpdating = False
    End With

    Dim Cl As Range
    Dim lngRow As Long
     
    With CreateObject("scripting.dictionary")
        For Each Cl In Range("E2", Range("E" & Rows.Count).End(xlUp))
            If Not .Exists(Cl.Value) Then .Add Cl.Value, (.Count Mod 2)
            lngRow = Cl.Row
            If .Count Mod 2 = 0 Then
                Range(Cells(lngRow, "A"), Cells(lngRow, "G")).Interior.Color = RGB(179, 230, 255)
            Else
                Range(Cells(lngRow, "A"), Cells(lngRow, "G")).Interior.Color = RGB(255, 255, 197)
            End If
        Next Cl
    End With
    
    With Application
        .ScreenUpdating = True
    End With
 
End Sub

While searching this forum (and google) before posting I found this thread HERE
The user was asking how to colour every other row only and again I have struggled to adapt it to my needs.
VBA Code:
Sub ColorAlternate()
Dim LR As Long, i As Long
'Stop the screen from flickering
Application.ScreenUpdating = False
'Find the last filled row in column A
LR = Range("A" & Rows.Count).End(xlUp).Row
'Loop through the filled rows in steps of 2
For i = 2 To LR Step 2
'Colour alternate rows
    Rows(i).EntireRow.Interior.ColorIndex = 6
Next i
'Turn screen updating on again
Application.ScreenUpdating = True
End Sub

Could someone kindly help me out?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Are you going to do this only once or multiple times? If many, I'd say there are issues you'd want to deal with: what is the colour of the last AG row?
If nothing, you'd start with 179, 230, 255?
If it's coloured with one of those rgb values, you'd pick up from where you left off and start with the other rgb value?
If you insert a row you'd mess up the pattern, so it would be better and easier just to start again from row 1. There's no header row?

EDIT - actually if you just start over, none of that should matter, I think. :)
 
Upvote 0
maybe try this
VBA Code:
Sub ColourAlternateRows()
Dim Cl As Range
Dim lngRow As Long, i As Long
Dim strRGB As String

On Error GoTo errHandler
Application.ScreenUpdating = False
lngRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
strRGB = "255, 255, 197"
For i = 1 To lngRow
     Set Cl = Range("A" & i, "G" & i)
     If strRGB = "255, 255, 197" Then
          Cl.Interior.Color = RGB(179, 230, 255)
          strRGB = "179, 230, 255"
     Else
          Cl.Interior.Color = RGB(255, 255, 197)
          strRGB = "255, 255, 197"
     End If
Next

exitHere:
With Application
     .CutCopyMode = False
     .ScreenUpdating = True
End With
Set Cl = Nothing
Exit Sub
 
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub
 
Upvote 1
Are you going to do this only once or multiple times? If many, I'd say there are issues you'd want to deal with: what is the colour of the last AG row?
If nothing, you'd start with 179, 230, 255?
If it's coloured with one of those rgb values, you'd pick up from where you left off and start with the other rgb value?
If you insert a row you'd mess up the pattern, so it would be better and easier just to start again from row 1. There's no header row?

EDIT - actually if you just start over, none of that should matter, I think. :)
The plan is that in the short term, as new data is pulled in from the other worksheets, I would insert code just before the "Colour Row"
code runs that clears the colour formatting, and then reapplys the Colour Code.

In the long term I aim to have the whole work sheet update dynamically when ever new data is added within the work book
but I am attacking it one issue at a time.
 
Upvote 0
You kindly posted your code suggestion just as I was typing my previous answer.

Thank you for this and I will try it out. :)
 
Upvote 0
maybe try this
VBA Code:
Sub ColourAlternateRows()
Dim Cl As Range
Dim lngRow As Long, i As Long
Dim strRGB As String

On Error GoTo errHandler
Application.ScreenUpdating = False
lngRow = Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
strRGB = "255, 255, 197"
For i = 1 To lngRow
     Set Cl = Range("A" & i, "G" & i)
     If strRGB = "255, 255, 197" Then
          Cl.Interior.Color = RGB(179, 230, 255)
          strRGB = "179, 230, 255"
     Else
          Cl.Interior.Color = RGB(255, 255, 197)
          strRGB = "255, 255, 197"
     End If
Next

exitHere:
With Application
     .CutCopyMode = False
     .ScreenUpdating = True
End With
Set Cl = Nothing
Exit Sub
 
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub
Works perfectly....

the inclusion of the error message is brilliant, I would not have thought of that.

I can not thank you enough, thank you so much.
 
Upvote 0
I prefer to include an error handler if application level properties are altered (e.g. ScreenUpdating) because altering them then raising an error will leave them off in many cases. Depending on circumstances, that could be the case until the application is closed and re-opened and you go nuts trying to figure out why changes aren't "working".
Glad I could help and thanks for the recognition and appreciation.
 
Upvote 0
Well as welll as helping me I have learnt something from your code as well which is a huge bonus
as I look to expand my understanding of Excel.

Thank you again. :)
 
Upvote 0
I am sorry to re-open my solved question but I wonder if I may ask for help with a tweek to your code.

Is there a way of starting the coloured rows on Row 2 therefore ignoring row 1 as I would like Row 1 (which has black titles)
on light grey background).

Or I suppose another way would be for the code to colour Row 1 in light grey then, colour the other rows in the way it
currently does.

To this end I have tried the following but with out any success.

VBA Code:
Sub ColourAlternateRows()
Dim Cl As Range
Dim lngRow As Long, i As Long
Dim strRGB As String

On Error GoTo errHandler
Application.ScreenUpdating = False

lngRow = Cells.Find(What:="*", After:=Range("A"), LookAt:=xlPart, LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
strRGB = "255, 255, 197"
For i = 1 To lngRow

'I changed "A" & "G" in the below to "A2" & "G2" but with no success.
     Set Cl = Range("A2" & i, "G2" & i)
     If strRGB = "255, 255, 197" Then
          Cl.Interior.Color = RGB(179, 230, 255)
          strRGB = "179, 230, 255"
     Else
          Cl.Interior.Color = RGB(255, 255, 197)
          strRGB = "255, 255, 197"
     End If
Next

exitHere:
With Application
     .CutCopyMode = False
     .ScreenUpdating = True
End With
Set Cl = Nothing
Exit Sub

'This is the code that formats the Top Row

    Range("A1:G1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
 
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub
 
Upvote 0
Since you're trying to learn I'll first say that "i" is what governs it. So what do you think needs to change? I'll pm you with the answer so you can try to fix it yourself and not see the answer until you try. It's actually quite simple so don't think "complex" thoughts!
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top