Sub FindEmptyLines()
With Лист1
Dim i&, a(), rg As Range, s As String
With .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
a = WorksheetFunction.Transpose(.Value)
End With

For i = LBound(a) To UBound(a)
     If InStr(a(i), "Item") Then
        If InStr(a(i + 1), "PR No.") = 0 Then
            If rg Is Nothing Then Set rg = .Rows(i + 1) Else Set rg = Union(rg, .Rows(i + 1))
        If Len(s) = 0 Then
            s = "A" & i + 1
        Else: s = s & Chr(44) & "A" & i + 1: End If
        End If
     End If
Next i

If Not rg Is Nothing Then
rg.Interior.Color = 255
rg.Font.Color = 16777215
MsgBox "Не указаны PR номера в следующих ячейках: " & vbNewLine & s, vbCritical, "ВНИМАНИЕ!"
End If
End With
End Sub