You're welcome
Just to tidy up, add the line in red. It will delete the last Chr(10) from the string so you don't have an empty line at the bottom of the cell.
Sub DelPH()
Dim i As Long, j As Long, txtOld() As String, txtNew As String
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
txtNew = ""
If InStr(Cells(i, 1), "PH") Then
txtOld = Split(Cells(i, 1), Chr(10))
For j = LBound(txtOld) To UBound(txtOld)
If InStr(txtOld(j), "PH") = 0 Then
txtNew = txtNew & txtOld(j) & Chr(10)
End If
Next
txtNew = Left(txtNew, (Len(txtNew) - 1))
Cells(i, 1) = txtNew
End If
Next
End Sub