Delete rows between two dates

  • Thread starter Thread starter jocker
  • Start date Start date
J

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
 
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)
 
That's it (I think) however I get message Error 13, Type mismatch.

Any ideas on how to fix.

+++++++++++
 
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.
 
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)
 
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
 
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)
 
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
Click to expand...


=============
 
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
 
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.
 
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)
 
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 ?
 
Back
Top