Loop through rows (Dynamic number)

Hi All,

I have created the code below (Spreadsheet Attached) which works for the first row but I want the code to loop through each row. I know there is a way aroud this by using count and then the rows will increment by 1 every time it loops through the code. Unfortunately I do not know how to do this.

P.s. i do not want to specify how many rows and the number of rows is dynamic.

Any ideas? Any help would be greatly appreciated.

Option Explicit
Sub RuleTesting()

Dim QRule As String
Dim RTRule As String
Dim CurrentResult As Integer
Dim Red As String
Dim Amber As String
Dim Green As String
Dim Status As Range
Dim RedNo As String
Dim GreenNo As String
Dim Symbol As String

Set Status = ThisWorkbook.Sheets("Results_Q").Range("F2")

' Variables
QRule = ThisWorkbook.Sheets("Results_Q").Range("E2").Value
RTRule = ThisWorkbook.Sheets("RuleTable_RT").Range("A2").Value
CurrentResult = ThisWorkbook.Sheets("Results_Q").Range("D2").Value
RedNo = ThisWorkbook.Sheets("RuleTable_RT").Range("C2").Value
GreenNo = ThisWorkbook.Sheets("RuleTable_RT").Range("G2").Value
Symbol = ThisWorkbook.Sheets("RuleTable_RT").Range("B2").Value


' Selects first 'Status' cell & Loop Through rows
ThisWorkbook.Sheets("Results_Q").Range("F2").Select
Do Until ActiveCell.Offset(1, -1) = ""
ActiveCell.Offset(1, 0).Select
' Calculate the RAG
If Symbol = ">" Then

If CurrentResult > RedNo Then
Status = "Red"
ElseIf CurrentResult < GreenNo Then Status = "Green"
ElseIf Symbol = ">" Then Status = "Amber"

ElseIf Symbol = "<" Then

If CurrentResult < RedNo Then
Status = "Red"
ElseIf CurrentResult > GreenNo Then Status = "Green"
Else: Status = "Amber"



End If
End If
End If
Loop
End Sub

Kind regards,

James Elwell

Hi James

Try this

Option Explicit
Sub RuleTesting()

  Dim QRule As String
  Dim RTRule As String
  Dim CurrentResult As Double
  Dim Status As Range
  Dim RedNo As String
  Dim GreenNo As String
  Dim Symbol As String
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim LR As Long, cel As Range

  Set ws1 = Sheets("Results_Q")
  Set ws2 = Sheets("RuleTable_RT")

  With ws1
    LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row

    For Each cel In Range("E2:E" & LR)
      Set Status = .Range("F" & cel.Row)
      ' Variables
      QRule = .Range("E" & cel.Row).Value
      RTRule = ws2.Range("A" & cel.Row).Value
      CurrentResult = .Range("D" & cel.Row).Value
      RedNo = ws2.Range("C" & cel.Row).Value
      GreenNo = ws2.Range("G" & cel.Row).Value
      Symbol = ws2.Range("B" & cel.Row).Value
      If Symbol = ">" Then

        If CurrentResult > RedNo Then
          Status = "Red"
        ElseIf CurrentResult < GreenNo Then Status = "Green"
        ElseIf Symbol = ">" Then Status = "Amber"
        Else
        End If
        
        ElseIf Symbol = "<" Then
          If CurrentResult < RedNo Then
            Status = "Red"
          ElseIf CurrentResult > GreenNo Then Status = "Green"
          Else: Status = "Amber"
          End If
        End If
    Next cel
  End With
End Sub

You're welcome...glad I could help. Thanks for the Rep.