Delete rows between two dates

[jocker]

I am using this code to delete rows which contain "perm" and "Client
EndDate" .
I also wish to delete rows before now and after now + 30 days.
I've tried all sorts of combinations without success. Can somwone help a
relative newcomer to VBA

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" Then .Rows(Lrow).Delete
'+++++++++++++++++++++++++++++++++++++++++
End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

 

[Bob Phillips]

This tests a date in column D

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" And _
(.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


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[jocker]

That's it (I think) however I get message Error 13, Type mismatch.

Any ideas on how to fix.

+++++++++++

 

[jocker]

Does this code delete rows only if "perm" and "Client Enddate" and outwith
the 2 dates.

I would like to delete rows if
a) "Perm" and "Client EndDate" or
b) outwith the 2 dates.

 

[Bob Phillips]

Yes, you are correct. For an OR, use

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

Are you still getting error 13? I don't get that. Where does it happen?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[jock]

Yes, I'm still getting it. Debug highlights all of your latest code

I appreciate your help here. Could it be the format of my dates which
are exported from Outlook

 

[Bob Phillips]

No, it might not work if the dates were of an odd format, it wouldn't throw
the code off like that. Did you wrap that code up in a macro?

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Jef Gorbach]

consider these:

'use autofilter to hide the desired dates to keep then delete all visible
rows
'change cells(finalrow,7) to however many columns you have
'change field:=1 to whichever is your date column
finalrow = range("A65536").end(xlup).row
BOM = "<" & beforenow
EOM = ">" & beforenow+30
With Range(Cells(1, 1), Cells(finalrow, 7)) 'change 7 to however many
columns you have
..AutoFilter Field:=1, Criteria1:=BOM, Operator:=xlOr, Criteria2:=EOM
..Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
..SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False 'turn off autofilter

'now remove rows with col(A)=perm and col(c)=client enddate
for lrow = finalrow to 2 step -1
if trim(lcase(range("A"&lrow).value))="client enddate" _
and trim(lcase(range("C"&lrow).value))="perm" _
then rows.delete
next lrow
===============================

' 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" Then .Rows(Lrow).Delete
'+++++++++++++++++++++++++++++++++++++++++
End If

=============

 

[jock]

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").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"), 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

 

[jock]

Jef, your code deletes ALL lines.
The < and > dates show up correctly in a msgbox

 

[jock]

I am convinced that the exported "dates" from Outlook are text. Can you
oblige by giving me code which will change column C from text to dates.
I have searched Google Groups for such code to no avail.

 

[Bob Phillips]

Maybe

ElseIf (Trim(LCase(.Cells(Lrow, "C").Value)) = "perm" And _
.Cells(Lrow, "A").Value = "Client EndDate") Or _
(CDate.Cells(Lrow, "D").Value) < Date Or _
CDate(.Cells(Lrow, "D").Value) > Date + 30) Then
.Rows(Lrow).Delete


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[jock]

Got an "expected ( " error, changed your code to
ElseIf (Trim(LCase(.Cells(Lrow, "C").Value)) = "perm" And _
.Cells(Lrow, "A").Value = "Client EndDate") Or _
CDate(.Cells(Lrow, "D").Value) < Date Or _
CDate(.Cells(Lrow, "D").Value) > Date + 30 Then
.Rows(Lrow).Delete

still getting "Type Mismatch"

I have managed to write code to change text to dates, thanks.
Should I give up and start growing vegetables ?