Looping code sequence

[FrenchCelt]

Hello,

I'm trying to loop a sequence of code until all instances of specific text in my sheet have been modified a certain way.

This is what I tried on my own:

For x = 1 To 10
    Cells.Find(What:="NO PINWHEEL", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(-1, 0)).Select
    With Selection.Font
        .Name = "Andale WT"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Find(What:="NO PINWHEEL", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).EntireColumn.AutoFit
    Next x

I had hoped that by simply repeating the code 10 times (it will never appear more often than 10 times, hence why I picked that number), it could find all instances of NO PINWHEEL and modify as instructed, but it only works sporadically and sometimes catches them all and sometimes not, depending on placement within the sheet. Can anyone suggest a better solution?

 

[Alex Blakenburg]

Maybe something like this.
Note: I am not testing for finding your searched words in row 1. Should it be found in row one it will error out since you are wanting to update the row above the found cell as well.

Sub UpdateFoundCells()

    Dim FoundCell As Range, rngToUpdate As Range
    Dim LastCell As Range
    Dim strToFind As String, FirstAddr As String
    
    strToFind = "NO PINWHEEL"
    Set FoundCell = Cells.Find(What:=strToFind, After:=Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
       
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
  
        Do
            If rngToUpdate Is Nothing Then
                Set rngToUpdate = FoundCell.Offset(-1).Resize(2)
            Else
                Set rngToUpdate = Union(rngToUpdate, FoundCell.Offset(-1).Resize(2))
            End If
          
            Set FoundCell = Cells.FindNext(After:=FoundCell)
               
            If FoundCell Is Nothing Then Exit Do
   
        Loop Until FoundCell.Address = FirstAddr
    End If
    
    With rngToUpdate.Font
        .Name = "Andale WT"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With rngToUpdate
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
End Sub

 

[FrenchCelt]

I forgot to remove the offset to include the cell above when I pasted the original code. It was part of an earlier attempt to add something else that I ended up deciding wasn't going to work. What parts of the code you provided should I alter/delete to take that aspect out?

 

[FrenchCelt]

Never mind, I added some additional code to compensate for the changes made by selecting the cell above where the text is found, so all is well. Thanks for the solution!

 

[Alex Blakenburg]

Don't do, that just change the 2 places you see this:

FoundCell.Offset(-1).Resize(2)

to be just this:

FoundCell

In context they are:

            If rngToUpdate Is Nothing Then
                Set rngToUpdate = FoundCell
            Else
                Set rngToUpdate = Union(rngToUpdate, FoundCell)
            End If

 

[FrenchCelt]

Excellent, thanks!