delete previous rows on date and time

[Mr Marvin]

i all, i have this macro below which deletes all rows from the prev day.

Sub DeleteFromDate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim LR As Long
LR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
Cells.AutoFilter Field:=6, Criteria1:="<=" & DateR
ALR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
If ALR > 1 Then
Range("F2:F" & LR).SpecialCells(xlCellTypeVisible).Select
Range("F2:F" & LR).Delete
Range("F1").Activate
End If
Cells.AutoFilter
MsgBox "Finished deleting rows"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

on my report i have it sorted on the created date and the column which details the created date and time is shown as e.g. Oct 4, 2021 7.55 PM. with the macro above it removes all rows from the previous day but what i am trying to is expand that and remove any rows that have the created date before 8.00 PM the previous day. So my daily report which i received on the 5th would show all information from the 4th backwards. but i only need the rows from the 3rd, 8.00 PM onwards.


Any help or guidance if this is possible would be greatly appreciated

thanks

 

[Alex Blakenburg]

See if this works for you:

Sub DeleteFromDate()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim TitleMsg As String
    Dim DateR As Long
    Dim TimeR As Double
    Dim DateTimeR As Double
    Dim ALR As Long
    
    Dim LR As Long
    LR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
    TimeR = TimeValue("08:00 PM")
    DateTimeR = DateR + TimeR
    Cells.AutoFilter Field:=6, Criteria1:="<" & DateTimeR

    ALR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    If ALR > 1 Then
        Range("F2:F" & LR).SpecialCells(xlCellTypeVisible).Select
        Range("F2:F" & LR).Delete
        Range("F1").Activate
    End If

    Cells.AutoFilter
    MsgBox "Finished deleting rows"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Mr Marvin]

thank you for the response, i have tested this. it removes all the rows for the that day that have the created date and time < 8.00 PM.

if my report shows information from the 5th of oct for example i need to remove rows from the previous date that show Oct 4th, 8.00 PM. So any rows that show the created date and time before that would be deleted and i just be left with rows that with information from the Oct 4th, 8.00 PM to Oct 5th, 8.00 PM
this is a daily report so i would be doing the same then looking for rows/information Oct 5th, 8.00 PM to Oct 6th, 8.00 PM etc.

 

[Mr Marvin]

perhaps a different angle of attack is having a macro that will remove any rows older than 12 hours from the first row in the worksheet as it is sorted with the newest created date / time to oldest. that could leave same information/rows going back 12 hours and anything prior to 12 hours can be deleted. can this macro be adjusted to show this

VBA Code:
Sub DeleteFromDate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim TitleMsg As String
Dim DateR As Long
Dim TimeR As Double
Dim DateTimeR As Double
Dim ALR As Long

Dim LR As Long
LR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
DateR = Application.InputBox("Enter based on date to delete", TitleMsg, FormatDateTime(Date, vbShortDate), Type:=1)
TimeR = TimeValue("08:00 PM")
DateTimeR = DateR + TimeR
Cells.AutoFilter Field:=6, Criteria1:="<" & DateTimeR

ALR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
If ALR > 1 Then
Range("F2:F" & LR).SpecialCells(xlCellTypeVisible).Select
Range("F2:F" & LR).Delete
Range("F1").Activate
End If

Cells.AutoFilter
MsgBox "Finished deleting rows"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

It's quite late here in Australia, I can have a look tomorrow.

 

[Mr Marvin]

thanks Alex

 

[Alex Blakenburg]

See if this works for you.
I opted not to rely on the sort and used this.
DateTimeR = WorksheetFunction.Max(Range("F1:F" & LR)) - 1 / 2
Note: The "- 1/2" is half a day ie your 12 hrs

Sub DeleteFromDate()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim TitleMsg As String
    Dim DateR As Long
    Dim TimeR As Double
    Dim DateTimeR As Double
    Dim ALR As Long
 
    Dim LR As Long
    LR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    DateTimeR = WorksheetFunction.Max(Range("F1:F" & LR)) - 1 / 2
 
    Cells.AutoFilter Field:=6, Criteria1:="<=" & DateTimeR
    ALR = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    If ALR > 1 Then
        Range("F2:F" & LR).SpecialCells(xlCellTypeVisible).Select
        Range("F2:F" & LR).Delete
        Range("F1").Activate
    End If

    Cells.AutoFilter
    MsgBox "Finished deleting rows"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Mr Marvin]

thanks Alek for the reply. i have a run time error 1004 application defined or object defined error

 

[Alex Blakenburg]

What line of code is highlighted ?

 

[Mr Marvin]

Cells.AutoFilter Field:=6, Criteria1:="<=" & DateTimeR