Bob,
The complete macro is :-
Sub Outlook_Reminders_amended_current()
' subtract CALC
Range("e2").Select
ActiveCell.FormulaR1C1 =
"=IF((RC[-2])="""",""1"",IF((RC[-4])=""Birthday"",(RC[-2])-4,(RC[-2])-42))"
' REMINDER COLUMN
Dim AmyRange As Range
Set AmyRange = Worksheets("Sheet1").Range("d2")
AmyRange.Formula = "=date(year(e2),month(e2),day(e2))"
' CALC COLUMN FILL
Call LastCell(Sheet1)
ActiveCell.Name = "lastqq"
' Selection.SpecialCells(xlCellTypeLastCell).Select
ActiveCell.Offset(0, -1).Select
ActiveCell.Name = "lastbirth"
Range("e2").Select
Selection.AutoFill Destination:=Range("e2:lastqq"),
Type:=xlFillDefault
' REMINDER COLUMN FILL
' Selection.SpecialCells(xlCellTypeLastCell).Select
Call LastCell(Sheet1)
ActiveCell.Name = "lastqq"
ActiveCell.Offset(0, -1).Select
ActiveCell.Name = "lastxx"
Range("d2").Select
Selection.AutoFill Destination:=Range("d2:lastxx"),
Type:=xlFillDefault
'+++++ copy and paste values +++++++++++++++++++++
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "dd-mm-yy"
'++++++++++++++++++++++++++++++++++++++++++++
' DELETED PERM AND CLIENT ENDDATE

Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.DisplayPageBreaks = False
StartRow = 1
EndRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "A").Value) Then ' Do nothing

'This will delete each row with the Values in Columns A and C, case
insensitive.
ElseIf (Trim(LCase(.Cells(Lrow, "C").Value)) = "perm" And _
.Cells(Lrow, "A").Value = "Client EndDate") Or _
(.Cells(Lrow, "D").Value < Date Or _
.Cells(Lrow, "D").Value Date + 30) Then
.Rows(Lrow).Delete

End If
Next
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& &&&&&&&&&
'
'SORTS ONLY THOSE WITH DATES
' With Range("c1:c200")
' x = .Find("/").Row
'MsgBox x
'End With
'With Range("c11:c200")
'y = .Find("").Row - 1
'MsgBox y

'Rows(x & ":" & y).Select
' Selection.Sort Key1:=Range("D:D"), Order1:=xlAscending,
Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
' DataOption1:=xlSortNormal
' End With

'++++++++++++++++++++++++++++++
' ActiveWorkbook.Save
Range("a1").Select

MsgBox "YELLOW = Client End Date, BLUE = Details missing, PURPLE = Due
within 28 days"
End Sub