I have fixed it.

Sub FIND_PP_VIA_COL_D()
Dim rng As Range
Dim B
Dim n
Dim BAddress
On Error Resume Next
n = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("d2:d" & n)
With rng
Set B = .Find("1", LookIn:=xlValues)
If Not B Is Nothing Then
BAddress = B.Address
Do
If B.Offset(0, 0).Value = 1 And B.Offset(0, -1).Value = "PP" Then
B.Offset(0, -3).Value = "`00000C"
B.Offset(0, -2).Value = "`00000"
Set B = .FindNext(B)
Loop While Not B Is Nothing And BAddress < B.Address
End If
End With
Set rng = Nothing
End Sub

cheers,
Russell Excel 2010 - Win 7 Pro

On Friday, 26 June 2015 09:57:23 UTC+12, wrote:
Manipulating the data - if there is only one entry with 1 in column D and with "PP" in Col C the macro hangs until <Esc is pressed.
Most frustrating!!
Russell
On Thursday, 25 June 2015 10:17:02 UTC+12, wrote:
Thanks Claus,
But the macro still does not terminate - still only on pressing <Esc does it stop and then shows the data has been processed correctly.
Still a puzzle as I use 8 other macros to perform similar tasks on the same data without any issues, but none of them looks at column D numbers as a determinate.
Regards,
Russell


On Wednesday, 24 June 2015 16:05:35 UTC+12, wrote:
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