Trouble with macro to delete rows

[SCPbrito]

I have this Macro below that is meant to delete rows based on the time. I run the macro and im getting a "subscript out of range" error. I used this macro before on another worksheet and it worked fine. Im updating the macro for this new worksheet but cant get it to work. I have a worksheet named "Item_Transaction"

    Dim wsItem_Transaction As Worksheet
    Dim lastRow As Long
    Dim currentTime As Date
    Dim cutoffTime As Date
    Dim i As Long

    ' Set wsItem_Transaction to the correct worksheet
    Set wsItem_Transaction = ThisWorkbook.Worksheets("Item_Transaction") ' Replace "Item_Transaction" with your actual sheet name

    Application.ScreenUpdating = False

    With wsItem_Transaction.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=wsItem_Transaction.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange wsItem_Transaction.Range("$A$1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    wsItem_Transaction.Columns("E:E").NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"

    ' Find the last row with data in column E
    lastRow = wsItem_Transaction.Cells(wsItem_Transaction.Rows.Count, "E").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 B is before the cutoff time
        If IsDate(wsItem_Transaction.Cells(i, 2).Value) Then
            If wsItem_Transaction.Cells(i, 2).Value < cutoffTime Then
                ' Delete the row if the condition is met
                wsItem_Transaction.Rows(i).Delete
            End If
        End If
    Next i

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
End Sub

 

[Jeffrey Mahoney]

Were you using the code I provided or your original code?

 

[SCPbrito]

Here is the code I used. It was a mix of both and then ran it through chatgpt

Sub Packer7AM()
    Dim wsItem_Transaction As Worksheet
    Dim lastRow As Long
    Dim currentTime As Date
    Dim cutoffTime As Date
    Dim i As Long
    Dim u As Range
    Dim Cel As Range
    Dim R As Range

    ' Set wsItem_Transaction to the correct worksheet
    Set wsItem_Transaction = ActiveWorkbook.Worksheets("Item_Transaction")

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Sort the data in column A
    With wsItem_Transaction.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=wsItem_Transaction.Range("E1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange wsItem_Transaction.Range("$E$1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Format column E for consistency
    wsItem_Transaction.Columns("E:E").NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"

    ' Identify the last row with data
    With wsItem_Transaction
        If .Cells(.Rows.Count, "E").End(xlUp).Row < 2 Then
            MsgBox "No data to process.", vbInformation
            Exit Sub
        End If

        ' Set the range to process
        Set R = .Range(.Cells(.Rows.Count, "E").End(xlUp), .Range("E1"))

        ' Get the current time and set the cutoff time
        currentTime = Now
        cutoffTime = DateValue(currentTime) + TimeValue("06:50:00")

        ' Loop through rows to identify rows to delete
        For Each Cel In R
            If IsDate(.Cells(Cel.Row, 2).Value) Then
                If .Cells(Cel.Row, 2).Value < cutoffTime Then
                    If Not u Is Nothing Then
                        Set u = Union(u, Cel)
                    Else
                        Set u = Cel
                    End If
                End If
            End If
        Next Cel

        ' Delete identified rows
        If Not u Is Nothing Then
            u.EntireRow.Delete
        End If
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Macro complete!"
    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "An error occurred: " & Err.Description, vbExclamation
End Sub

 

[Jeffrey Mahoney]

Do you know how to debug line by line? I suggest you add a breakpoint on this line: If Not u Is Nothing Then. If it doesn't stop there, then you have no qualifying cells.

Dates are kinda buggy. I suggest you add a new Date variable and temporarily add your cell value to that variable to compare.

Dim CellDate as Date
CellDate = .Cells(Cel.Row, 2).Value
IF CellDate < cutoffTime then . . . .

So you are trying to get rid of rows with dates that are 6 hours and 50 minutes ahead of the current date/time?

 

[SCPbrito]

Sorry i dont know how to debug. Im very new to excel. Im trying to delete all rows that have a timestamp of before 7AM of current day in column E

 

[Jeffrey Mahoney]

Ok, so the date time you have created for Cutofftime is the current date /Time + 6 hours and 50 minutes. So if the current time is 15:00, the cutofftime becomes 21:50

Try this. Midnight plus 7 hours of current day

cutoffTime = Int(Now) + TimeValue("07:00:00")

Clicking in the margin sets a breakpoint. When you run the code it stops there so you can hover over variables and see the values.