The following code does as intended but hangs until the <Esc key is pressed.
There is data in columns A to D (approx. 8,400 rows) with some blank cells in Column C. Code finds the string "PP" in cells in column C and if the corresponding cell in D has a value of 1 changes values in A, B and C. If the value in D is < 1 then moves on to the next cell and should terminate when the last cell in C is evaluated - but doesn't!


Sub DELETE_100_PERCENT_PP()
'//**** REMOVES DATA WITH 100% PP *******
Dim rng As Range
Dim X
Dim n
Dim XAddress
On Error Resume Next
n = Range("a2", Range("a2").End(xlDown)).Count - 1
Set rng = Range("c2", Range("c2").Offset(n, 0))
With rng
Set X = .Find("PP", LookIn:=xlValues)
If Not X Is Nothing Then
XAddress = X.Address
Do
If X.Offset(0, 1).Value = 1 Then
X.Offset(0, -2).Value = "`00000C"
X.Offset(0, -1).Value = "`00000"
X.Offset(0, 0).Value = " "
End If
Set X = .FindNext(X)
Loop While Not X Is Nothing And X.Address < XAddress
End If
End With
Set rng = Nothing
End Sub

Any help appreciated.
Russell - Excel 2010