Delete rows before a certain time

[SCPbrito]

I have a data set that i need to sort entry numbers from Column"A" from smallest to largest. Then format column "B" to show date and time and then delete all rows that have a timestamp before 6:50am of the current day. Had some help from Chatgpt but it not deleting the rows.

 ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    Selection.NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"
    
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentTime As Date
    Dim cutoffTime As Date
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' Find the last row with data in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Get the current date and time
    currentTime = Now
    ' Set the cutoff time for the current day at 6:50 AM
    cutoffTime = DateValue(currentTime) + TimeValue("06:50:00")

    ' Loop from the last row to the first row (bottom-up)
    For i = lastRow To 1 Step -1
        ' Check if the timestamp in column A is before the cutoff time
        If IsDate(ws.Cells(i, 1).Value) Then
            If ws.Cells(i, 1).Value < cutoffTime Then
                ' Delete the row if the condition is met
                ws.Rows(i).Delete
            End If
        End If
    Next i
End Sub

 

[SCPbrito]

I've been wracking my brain all day trying to figure this out. I've tried to isolate the code and just use the for loop to delete the rows and still nothing happens. I'm at a loss for words

 

[Joe4]

I will take a look in a short while. I am not at a place where I can download files right now.

I noticed your link says "Loading Google Sheets". You are doing this in Excel, and not Google Sheets, right?

 

[SCPbrito]

correct. I just used my personal Google drive to share the file

 

[Joe4]

Hmmm... Doesn't appear I can download that file anyway. It says "Access Denied - you need access".
I am not going to personally request access from my Google account.

 

[SCPbrito]

hmm. Let me see what i can do

 

[SCPbrito]

Try this link now. I changed the access

Loading Google Sheets

 

[Joe4]

I just ran the code against your data file, and since all the dates were before today, it successfully deleted all of them, like it should.
Is it not doing that for you?

I made some very minor adjustments to the code, to temporarily disable screen updating while it is going through the loop (since you are looping over 10000 rows!), and to pop-up a message box to let you know it is done. This doesn't change any of the logic, just a little housekeeping. Here is the code with those updates:

Sub MyMacro()

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:= _
        Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("$A$1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"
    
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentTime As Date
    Dim cutoffTime As Date
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' Find the last row with data in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Get the current date and time
    currentTime = Now
    ' Set the cutoff time for the current day at 6:50 AM
    cutoffTime = DateValue(currentTime) + TimeValue("06:50:00")

    ' Loop from the last row to the first row (bottom-up)
    Application.ScreenUpdating = False
    For i = lastRow To 1 Step -1
        ' Check if the timestamp in column A is before the cutoff time
        If IsDate(ws.Cells(i, 2).Value) Then
            If ws.Cells(i, 2).Value < cutoffTime Then
                ' Delete the row if the condition is met
                ws.Rows(i).Delete
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"

End Sub

 

[SCPbrito]

I just ran the code against the file also and its not deleting any line for me. I get the msg "Macro completed" but all rows are intact I'm not sure what is going on. This is very frustrating.

 

[Alex Blakenburg]

@SCPbrito
You did not answer Joe's question

Note: critical information when you use pictures: Row & Column References and Sheet Name.

Are you sure your sheet is really named "Sheet1" and not something else?

If your sheet really is called "Sheet1" then did you try the macro on the workbook you sent us ?

 

[SCPbrito]

Yes my sheet is called "Sheet1". I will record a video tomorrow using the macro for more clarity