Trouble with macro to delete rows

S

SCPbrito

Board Regular
Joined
Aug 1, 2024
Messages
60
Office Version
  1. 365
Platform
  1. Windows
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"

Rich (BB code): 
    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
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
See if you get an error with this

VBA Code: 
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 = 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
    With wsItem_Transaction
      Set R = .Range(.Cells(.Rows.Count, "E").End(xlUp), .Range("E1"))
    
      ' 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 Each Cel In R
          ' Check if the timestamp in column B is before the cutoff time
          If IsDate(.Cells(Cel.Row, 2).Value) Then
              If .Cells(Cel.Row, 2).Value < cutoffTime Then
                  ' Add to range for later deletion
                  If Not u Is Nothing Then
                    Set u = Union(u, Cel)
                  Else
                    Set u = Cel
                  End If
              End If
          End If
      Next i
      If Not u Is Nothing Then
        u.EntireRow.Delete
      End If
    End With
    

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
End Sub
 
Upvote 0
Yes I added that. It highlighting the first line Sub Packer7AM

Rich (BB code): 
Sub Packer7AM()
'
' Packer7AM Macro
'
'
'
' ScanRecordTest2 Macro


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 = 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
    With wsItem_Transaction
      Set R = .Range(.Cells(.Rows.Count, "E").End(xlUp), .Range("E1"))
    
      ' 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 Each Cel In R
          ' Check if the timestamp in column B is before the cutoff time
          If IsDate(.Cells(Cel.Row, 2).Value) Then
              If .Cells(Cel.Row, 2).Value < cutoffTime Then
                  ' Add to range for later deletion
                  If Not u Is Nothing Then
                    Set u = Union(u, Cel)
                  Else
                    Set u = Cel
                  End If
              End If
          End If
      Next i
      If Not u Is Nothing Then
        u.EntireRow.Delete
      End If
    End With
    

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
End Sub
 
Upvote 0
Forgot to change NEXT I to Next Cel

VBA Code: 
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 = 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
    With wsItem_Transaction
      Set R = .Range(.Cells(.Rows.Count, "E").End(xlUp), .Range("E1"))
   
      ' 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 Each Cel In R
          ' Check if the timestamp in column B is before the cutoff time
          If IsDate(.Cells(Cel.Row, 2).Value) Then
              If .Cells(Cel.Row, 2).Value < cutoffTime Then
                  ' Add to range for later deletion
                  If Not u Is Nothing Then
                    Set u = Union(u, Cel)
                  Else
                    Set u = Cel
                  End If
              End If
          End If
      [B]Next Cel[/B]
      If Not u Is Nothing Then
        u.EntireRow.Delete
      End If
    End With
   

    Application.ScreenUpdating = True

    MsgBox "Macro complete!"
End Sub
 
Upvote 0
SCPbrito said:
I run the macro and im getting a "subscript out of range" error.
Click to expand...
Assuming that's on this line
VBA Code: 
Set wsItem_Transaction = ThisWorkbook.Worksheets("Item_Transaction")
check the sheet name for any typos & also for any leading/trailing spaces.
 
Upvote 0
Here is my code. Still getting "subscript out of range" error. Text in yellow is where im getting the error in debugger

Rich (BB code): 
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 = ThisWorkbook.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("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

    ' 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
 
Upvote 0
What if you change that line of code to this:
Rich (BB code): 
Set wsItem_Transaction = ActiveWorkbook.Worksheets("Item_Transaction")
 
Upvote 0
Joe4 said:
What if you change that line of code to this:
Rich (BB code): 
Set wsItem_Transaction = ActiveWorkbook.Worksheets("Item_Transaction")
Click to expand...
That worked, it ran the code now. But it did not delete any rows that match the criteria from column E
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Delete rows before a certain time
2 3
Replies
26
Views
805
Joe4
Joe4
S
  • Question Question
Help with combining 2 macros into 1
Replies
8
Views
267
MARK858
MARK858
S
  • Solved
Having trouble with pivot table macro
2
Replies
12
Views
179
RoryA
RoryA
JeffGrant
  • Solved
Runtime Error 424 - not sure why.
Replies
3
Views
367
JeffGrant
JeffGrant
J
  • Question Question
Formatting error when switching from Mac to PC
Replies
6
Views
70
RoryA
RoryA

Forum statistics

Threads
1,223,996
Messages
6,175,862
Members
452,676
Latest member
woodyp

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top