Loop macro through rows

Question

EDIT: I have cleaned up the code as seen below. I am trying to find a way to execute the code with simply adding 1 to row in the offset ranges. Is this possible?? enter image description here

What I am trying to accomplish:

1. Find Columns “Wage QRE Exp” a. If the above cell is left adjacent to “Ref.” then I want to search their below values
2. Apply the macro to all lines in between the gray rows of the ‘QRE’ column. a. Fill in the page number references in the left adjacent cells b. Do until cell color = Gray -25% (.ThemeColor = xlThemeColorDark2) I believe

3. End

   Sub Find_Data()
   Dim datatoFind As String, MySheet As String, FV As String
   Dim aSh As Worksheet, fSh As Worksheet
   Dim firstResult As Range
   Dim secondResult As Range
   Dim rng As Range
   Dim LeftCell As Range
   Dim leftValue As String
   
   Set rng = Cells.Find(What:="Wage QRE Exp", after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
   Set LeftCell = rng.Offset(0, -1)
   leftValue = LeftCell.Value
   If leftValue = "Ref." Then
      Set findValue = rng.Offset(1, 0)
      Set aSh = Sheet1
      datatoFind = findValue
   
      sheetCount = ActiveWorkbook.Sheets.Count
      If Len(datatoFind) = 0 Or Not IsNumeric(datatoFind) Then Exit Sub
      For counter = 1 To sheetCount
         Sheets(counter).Activate
         Set firstResult = Cells.Find(What:=datatoFind, after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
         Set secondResult = Cells.FindNext(after:=firstResult)
         Debug.Print secondResult.Address
         If Not firstResult Is Nothing Then
             MySheet = IIf(InStr(secondResult.Parent.Name, "."), Split(secondResult.Parent.Name, ".")(0), Split(secondResult.Parent.Name)(0))
             FV = MySheet & "." & pageNum(secondResult)
         Else
         End If
      Next counter
      With rng.Offset(1, -1)
          .Value = FV
          .Font.Name = "Times New Roman"
          .Font.Bold = True
          .Font.Size = "10"
          .Font.Color = vbRed
          .HorizontalAlignment = xlRight
          .VerticalAlignment = xlCenter
      End With
   End If
   

   End Sub

Answer 1

Your code is a little hard to follow because you don't indent very much (I edited that) and there are no comments. So I'm not sure what section you want to repeat.

Generally, I suggest a Do loop. And identify the last row by its contents, not its color.

Set ColAcell to be Cell A5, then:

Do Until ColAcell.value = "Total"

   ... (your code to process the row) ...

   Set ColAcell = ColAcell.offset(1,0)

Loop