VBA Help with shading every other row

TkdKidSnake

Board Regular
Joined
Nov 27, 2012
Messages
231
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.

Code:
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
 
Last edited:

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
Code:
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

Board Regular
Joined
Nov 27, 2012
Messages
231
This is excellent works a treat, many thanks

Code:
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,504
Office Version
2010
Platform
Windows
Rich (BB code):
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))
 

Forum statistics

Threads
1,081,622
Messages
5,360,079
Members
400,569
Latest member
tcormack

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top