Hi Howard,

Am Thu, 16 Jun 2016 21:40:32 -0700 (PDT) schrieb L. Howard:

Sheets("Project Priorities").Activate
Range(Cells(2, blnkCol - 2), Cells(blnkRow, blnkCol)) _
.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

another suggestion without ClearContents and deleting the blank cells
into the loop:

Sub Test()
Dim TheTaskRng As Range ' input box selections
Dim aTsk As Range, aTskDel As Range, rngBig As Range

On Error GoTo NotValidInput

Set TheTaskRng = Application.InputBox( _
Prompt:="Select green font COMPLETED Task/s in Column E" & vbCr & _
"For removal from ""Project Priorities"" sheet", Type:=8)

If Not TheTaskRng.Column = 5 Then
MsgBox "Column E cell selection only"
Exit Sub
End If

Application.ScreenUpdating = False

With Sheets("Project Priorities")
For Each aTsk In TheTaskRng
Set aTskDel = .Cells.Find(What:=aTsk, LookIn:=xlValues, LookAt:=xlPart)
If Not aTskDel Is Nothing Then
aTsk.Offset(, 3) = aTsk.Offset(, 3) & "PP Del"
If rngBig Is Nothing Then
Set rngBig = aTskDel.Offset(, -2).Resize(1, 3)
Else
Set rngBig = Union(rngBig, aTskDel.Offset(, -2).Resize(1, 3))
End If
End If
Next 'aTsk
rngBig.Delete shift:=xlUp
End With

NotValidInput:
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016