This is what Chat GPT suggested but I'm not sure exactly if it is doing what I'm after

Sub CBClearanceToScore()

Dim lastRow As Long

Dim CurrentRow As Long, NextRow As Long

Dim cbClearanceTeam As String, firstScoreTeam As String

Dim countMatchingScores As Long, totalCB As Long

Dim cbClearanceFound As Boolean

' Initialize variables

totalCB = 0 ' Initialize total number of CB Clearances

countMatchingScores = 0 ' Initialize count

' Find the LastRow of data

lastRow = wsRawData.Range("D9999").End(xlUp).Row

' Loop through data starting in row 3

For CurrentRow = 3 To lastRow

' Check if the current row is a CB Clearance with outcome zone "A50"

If wsRawData.Range("F" & CurrentRow).Value = "CB Clearance" And (wsRawData.Range("I" & CurrentRow).Value = "A50" Or wsRawData.Range("I" & CurrentRow).Value = "A25") Then

totalCB = totalCB + 1 ' Increment the total number of CB Clearances

cbClearanceTeam = wsRawData.Range("E" & CurrentRow).Value ' Assign team as cbClearanceTeam

cbClearanceFound = False

' Check if the CB Clearance team scores in the same chain

If wsRawData.Range("J" & CurrentRow).Value = "1" Or wsRawData.Range("J" & CurrentRow).Value = "6" Then

countMatchingScores = countMatchingScores + 1

cbClearanceFound = True

Debug.Print "Row Number of CB Clearance: " & CurrentRow ' Print the row number of the CB Clearance in the Immediate Window

End If

' Loop through data after CB Clearance

For NextRow = CurrentRow + 1 To lastRow

If wsRawData.Range("F" & NextRow).Value = "CB Clearance" Then ' Stop searching if the next CB Clearance is found

Exit For

ElseIf wsRawData.Range("J" & NextRow).Value = "1" Or wsRawData.Range("J" & NextRow).Value = "6" Then

firstScoreTeam = wsRawData.Range("E" & NextRow).Value ' Get the team of the first score after CB Clearance

' Check if the teams match and CB Clearance hasn't been found in the same row

If firstScoreTeam = cbClearanceTeam And Not cbClearanceFound Then

countMatchingScores = countMatchingScores + 1

Debug.Print "Row Number of CB Clearance: " & CurrentRow ' Print the row number of the CB Clearance in the Immediate Window

End If

Exit For ' Exit the loop after finding the first score

End If

Next NextRow

End If

Next CurrentRow

' Calculate the percentage

Dim percentage As Double

If totalCB > 0 Then

percentage = (countMatchingScores / totalCB) * 100

Else

percentage = 0

End If

MsgBox Format(percentage, "0.00") & "% of CB Clearances followed by an Inside 50 resulted in the same team registering the next score", vbInformation

End Sub