Looping Through a Row and Selecting a Range of Cells in Columns

[FrenchCelt]

Hello,

I've been struggling to find a way to do this using my rudimentary VBA coding ability. I want to find specific text in a given row (4) and then select that cell plus the two cells above and one cell below. From there I will fill those cells with color (I have the VBA to do that once I have the cells selected). I tried two different methods and each one came up short.

My first try was especially awkward and it didn't do any looping. I basically did this:

Dim i As Long
    On Error Resume Next
    For i = 1 To 10
    Rows("4:4").Find("*STOP", Searchdirection:=xlRight).Offset(-2, 0).Select
    Next
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

And then repeated that three more times to select all the cells (offsetting -1, then no offset, and then offsetting 1) and give it the color I wanted. But that only worked for the first instance and the lack of code elegance was also disappointing. So I tried a loop function and this is what I tried:

Dim rng As Range, cell As Range
    On Error Resume Next
    rng = Rows("4:4")
    For Each cell In rng
    If cell.Value = "*STOP" Then
      cell.Offset(-2, 0).Select
    End If
    Next cell
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

All that did was select and color the entirety of Row 5, which is completely wrong.

Can anyone set me straight here? And if there is a way to do it one go, selecting the range of cells at once instead of having to do it four times to get each cell in the given columns being affected, that would be great.

 

[AlphaFrog]

Sub foo()
    
    Dim rngFound As Range
    Dim FirstFound As String
    
    Set rngFound = Rows("4:4").Find("*STOP", , xlValues, xlWhole, xlByRows, xlNext, False)
    
    If Not rngFound Is Nothing Then
        FirstFound = rngFound.Address
        Do
            With rngFound.Offset(-2, 0).Resize(4, 1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
            
            Set rngFound = Rows("4:4").FindNext(After:=rngFound)
            
        Loop Until rngFound.Address = FirstFound
    End If
    
End Sub

This may help explain the .Find method...
The Ultimate Search

 

[My Aswer Is This]

Try this:

Sub Check_Row_Four()
'Modified 12/6/2020  8:31:38 AM  EST
Application.ScreenUpdating = False
Dim Lastcolumn As Long
Lastcolumn = Cells(4, Columns.Count).End(xlToLeft).Column
Dim SearchString As String
Dim SearchRange As Range
SearchString = "Stop"
Set SearchRange = Cells(4, 1).Resize(, Lastcolumn).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox SearchString & "  Not Found": Exit Sub
SearchRange.Offset(-1).Resize(3).Select

With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With

Application.ScreenUpdating = True
End Sub

 

[FrenchCelt]

Thanks to both of you for replying. AlphaFrog's code worked great, but I do appreciate you taking the time to offer a solution as well, My Aswer Is This.