Highlight all rows with today's date

[jmpatrick]

Good morning!

I'm using this code to highlight all rows that have today's date in column B. It also scrolls the window to today's date.

I'd like to restrict the yellow highlight to the grid and not have it spill off to the right (past column AF as you can see).

Sub GoToDate()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
Dim cell As Range
Dim lr As Long
lr = Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B4:B" & lr)
        If CDate(cell.Value) = Date Then
            cell.EntireRow.Interior.ColorIndex = 6
        Else
            cell.EntireRow.Interior.ColorIndex = xlNone
        End If
Next
       
  Dim iRow As Long
  iRow = Evaluate("match(today(), " & Columns(2).Address & ")")
  Application.Goto Cells(iRow - 22, "B"), Scroll:=True
  Rows(iRow - 1).Select
  Range("B" & (ActiveCell.Row)).Select
  
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

 

[Fluff]

Try

cell.Offset(, -1).Resize(, 32).Interior.ColorIndex = 6

 

[jmpatrick]

Perfect! Thanks.

 

[Fluff]

Glad to help & thanks for the feedback.