how to avoid infinite loops ine excel vba ?

Hiii alll,
I have a requirement where I should check all the USED cells of an entire column and find if the first 4 letters is PT50.If its not PT50 it must be colored.However my code is going in infinte loop its processing all rows in the sheet.(those without data too).doesn stop.
HELPPPPPPPPPP how to avoid this infinite loop
this is my code
.Pleeeeeeeeeeeeeese correct it .seekin yr guidance .

Sub IbanNo()

Dim Result As String
LR = ActiveSheet.UsedRange.Rows.Count


For i = 4 To LR


val1 = Cells(i, 16).Value
Result = Left(val1, 4)

If Not Result Like "PT50" Then
Cells(i, 16).Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With

End If

Next i

End Sub

Something like this

Option Explicit

Sub IbanNo()
    Dim LR As Long
    Dim iX As Long
    Dim rRng As Range
    LR = ActiveSheet.UsedRange.Rows.Count

    For iX = 4 To LR

        If Left(Cells(iX, 16), 4) = "PT50" Then
            If rRng Is Nothing Then
                Set rRng = Cells(iX, 16)
            Else: Set rRng = Union(rRng, Cells(iX, 16))
            End If
        End If
    Next iX
    With rRng
        .Interior.ColorIndex = 3
    End With
End Sub

Hiii,
I found a way to overcome it.But it colours all other blank cells too . can we JUST color those cells NOT STARTING with PT50 ? any expert advice on this ?? Thaaaaanks in advance

Please find the code below i modified from yours.

Code:

Option Explicit

Sub IbanNo()
    Dim LR As Long
    Dim iX As Long
    Dim rRng As Range
    LR = ActiveSheet.UsedRange.Rows.Count

    For iX = 4 To LR

        If Left(Cells(iX, 16), 4) <> "PT50" Then
            If rRng Is Nothing Then
                Set rRng = Cells(iX, 16)
            Else: Set rRng = Union(rRng, Cells(iX, 16))
            End If
        End If
    Next iX
    With rRng
        .Interior.ColorIndex = 3
    End With
End Sub

If you study the code then you will learn. It;s not difficult to change

Option Explicit

Sub IbanNo()
    Dim LR As Long
    Dim iX As Long
    Dim rRng As Range
    LR = ActiveSheet.UsedRange.Rows.Count

    For iX = 4 To LR

        If Left(Cells(iX, 16), 4) <> "PT50" Then
            If rRng Is Nothing Then
                Set rRng = Cells(iX, 16)
            Else: Set rRng = Union(rRng, Cells(iX, 16))
            End If
        End If
    Next iX
    With rRng
        .Interior.ColorIndex = 3
    End With
End Sub

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

You've used Quote Tags not Code Tags

Please edit them & check this

Option Explicit

Sub IbanNo()
    Dim LR As Long
    Dim iX As Long
    Dim rRng As Range
    LR = ActiveSheet.UsedRange.Rows.Count

    For iX = 4 To LR

        If Not IsEmpty(Cells(iX, 16)) And Left(Cells(iX, 16), 4) <> "PT50" Then
            If rRng Is Nothing Then
                Set rRng = Cells(iX, 16)
            Else: Set rRng = Union(rRng, Cells(iX, 16))
            End If
        End If
    Next iX
    With rRng
        .Interior.ColorIndex = 3
    End With
End Sub

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save