Hi Russell,

Am Tue, 23 Jun 2015 21:05:27 -0700 (PDT) schrieb :

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!

try:

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 = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("C2:C" & n)
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 XAddress < X.Address
End If
End With
Set rng = Nothing
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional