VBA Help with shading every other row

[TkdKidSnake]

Hi all,

I am trying to make a spreadsheet easier to read, the sheet has many lines and varies in length. Column B will always have something in so this can be used to find the end of the data.

I am trying to shade in from B to S then miss T and shade U, the shading needs to start from row 5 however row 5 is essentially left alone and then the first shaded row would be row 6 see below:

Row 5 – no shading
Row 6 – Shaded
Row 7 – no shading
Row 8 – Shaded
Etc, Etc, Etc

I have recorded the following code to give you an idea of what I am trying to achieve.

Range("B6:S6,U6").Select
 Range("U6").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    
    Range("B8:S8,U8").Select
    Range("U8").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

Any help you can provide would be greatly appreciated

 

[wideboydixon]

Public Sub ShadeEventRows()

Dim lastRow As Long
Dim thisRow As Long
Dim shadeRange As Range

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
For thisRow = 6 To lastRow Step 2
    Set shadeRange = Application.Union(Range(Cells(thisRow, "B"), Cells(thisRow, "S")), Cells(thisRow, "U"))
    With shadeRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.6
        .PatternTintAndShade = 0
    End With
Next thisRow

End Sub

WBD

 

[TkdKidSnake]

Posted on wrong message doh!

 

[TkdKidSnake]

This is excellent works a treat, many thanks

Public Sub ShadeEventRows()

Dim lastRow As Long
Dim thisRow As Long
Dim shadeRange As Range

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
For thisRow = 6 To lastRow Step 2
    Set shadeRange = Application.Union(Range(Cells(thisRow, "B"), Cells(thisRow, "S")), Cells(thisRow, "U"))
    With shadeRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.6
        .PatternTintAndShade = 0
    End With
Next thisRow

End Sub

WBD

 

[Rick Rothstein]

Public Sub ShadeEventRows()

Dim lastRow As Long
Dim thisRow As Long
Dim shadeRange As Range

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
For thisRow = 6 To lastRow Step 2
    Set shadeRange = Application.Union(Range(Cells(thisRow, "B"), Cells(thisRow, "S")), Cells(thisRow, "U"))
    With shadeRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.6
        .PatternTintAndShade = 0
    End With
Next thisRow

End Sub

You can replace what I highlighted in red above with this shorter code snippet and it will also work...

Intersect(Range("A:S,U:U"), Rows(thisRow))