Delete rows that don't meet specific criterion

[Guest]

I have a huge report that lists information for many days. I want to delete
all rows that don't meet the criteria of todays date in column B. I also
want to only keep rows that have todays date with F800 in column D. I plan
on putting this code in a macro. Thanks so much....happy summer!!!

 

[Guest]

Thanks Ron, this look pretty complex....I'll add it to my macro and let you
know how it goes. One more question...my date, do I have to specificy a
format for it or will the code read any format for todays date. Thanks so
much, if this works it will be a huge time saver for my folks. I appreciate
all your time and effort.

 

[Ron de Bruin]

See my other reply in this thread for a correct example

 

[Ron de Bruin]

Hi

Test this one

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1

If .Cells(Lrow, "B").Value = Date And _
.Cells(Lrow, "D").Value = "F800" Then .Rows(Lrow).Delete


Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

 

[Ron de Bruin]

Oops do not read it good
Send you a new macro soon

 

[Ron de Bruin]

Try this

Sub Example2()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1

If .Cells(Lrow, "B").Value = Date And _
.Cells(Lrow, "D").Value = "F800" Then
' do nothing
Else
.Rows(Lrow).Delete
End If

Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub