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