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

FrenchCelt

Board Regular
Joined
May 22, 2018
Messages
135
Office Version
  1. 365
Platform
  1. Windows
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:

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

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

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
VBA Code:
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
 
Solution

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,256
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
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

Board Regular
Joined
May 22, 2018
Messages
135
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,012
Messages
5,599,337
Members
414,306
Latest member
Dennis_vdw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top