Set Interior Color for Portions of Rows with Text Present

[imtclimb]

Hi - I am trying to set a different interior color for portions of any row that has text present in Column J. So far I have been able to set the interior color for that cell in Column J only. I need to figure out who to be able to also set the interior color for Column B through Column I when there is text present in Column J. Here is what I have so far. I am thinking that I need to use an ActiveCell.Offset, but it is not working for me. I am wondering if I don't have an "ActiveCell" b/c of what else is going on in my macro. Any help would be greatly appreciated!

Sub ChangInteriorFillColor()


Dim zrng As Range
Dim zrr As Range
Dim zsAdd As String
Dim zsStr As String


zsStr = "total"


With Worksheets("Rollover").Range("J1:J500")
Set zrng = .Find(zsStr)
If Not zrng Is Nothing Then
zsAdd = zrng.Address
Do
If zrr Is Nothing Then
Set zrr = zrng
Else
Set zrr = Application.Union(zrr, zrng)
End If
Set zrng = .FindNext(zrng)
Loop While Not zrng Is Nothing And zrng.Address <> zsAdd
End If
End With


If Not zrr Is Nothing Then
zrr.Interior.Color = RGB(192, 192, 192)



End If
End Sub

 

[My Aswer Is This]

Try this:

Sub Test()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "J").End(xlUp).Row
    
    For i = 1 To Lastrow
        If Cells(i, "J").Value <> "" Then
            Range("B" & i & ":J" & i).Interior.ColorIndex = 4
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[imtclimb]

Worked perfectly. Thank you so much for the assistance!

 

[Sektor]

Would be more readable:

Range(Cells(i, "B"), Cells(i, "J").Interior.ColorIndex = 4

Or this way:

Cells(i, "B").Resize(, 9).Interior.ColorIndex = 4

 

[MARK858]

Another option if your cells in column J are text and not the result of formula

Sub ColTxt()
   With Columns("J:J").SpecialCells(xlCellTypeConstants, 23)
        .Interior.Color = RGB(192, 192, 192)
        .Offset(, -8).Interior.Color = RGB(192, 192, 192)
    End With
End Sub