Delete table rows if time in column is >07:45

Question

I'm new to VBA and have got most of what I need working but I've got stuck on this last part.

The sheet is being used to paste data into and then create a table for a specific purpose from the pasted data.

I need to write a macro that will delete the rows in a table that have a time later than 07:45 in the "Time" column.

The table is as follows:

ID	Surname	Init	Location	Time	Event	Destination
12	Name1	I1	Loc1	18:00	Ev1	Dest1
34	Name2	I2	Loc2	07:45	Ev2	Dest2
56	Name3	I3	Loc3	11:00	Ev3	Dest3
78	Name4	I4	Loc4	05:00	Ev4	Dest4

This is a screenshot of the table currently

After running the macro, it should look like:

ID	Surname	Init	Location	Time	Event	Destination
34	Name2	I2	Loc2	07:45	Ev2	Dest2
78	Name4	I4	Loc4	05:00	Ev4	Dest4

This is how the table should look after

I've already used this code to delete empty table rows on a different file, but I'm not sure how to adapt it to work for this purpose:

    Dim EventsRng As Range
    On Error Resume Next
    Set EventsRng = Range("Events[[ID]]").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not EventsRng Is Nothing Then
        EventsRng.Delete Shift:=xlUp
    End If

I was also suggested this, but haven't been able to adapt it to work either:

Private Sub deleteTableRowsBasedOnCriteria(tbl As ListObject, columnName As String, criteria As String)

    Dim x As Long, lastrow As Long, lr As ListRow
    lastrow = tbl.ListRows.Count
    For x = lastrow To 1 Step -1
        Set lr = tbl.ListRows(x)
        If Intersect(lr.Range, tbl.ListColumns(columnName).Range).Value = criteria Then
            'lr.Range.Select
            lr.Delete
        End If
    Next x

End Sub

Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Events")
Call deleteTableRowsBasedOnCriteria(tbl, "Time", ">07:45")

Answer 1

If you don't mind copying the results to another location, you can use a simple filter.

Assuming your first table is a Table named Events:

Option Explicit

Sub DeleteTblRows()
    Dim Tbl As ListObject
    Dim idCol As Long
    Dim Dest As Range
    
Set Tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Events")
idCol = Tbl.ListColumns("Time").Index

Tbl.AutoFilter.ShowAllData
Tbl.Range.AutoFilter Field:=idCol, Criteria1:="<=7:45", Operator:=xlAnd

Set Dest = ThisWorkbook.Worksheets("Sheet1").Cells(20, 1)
Dest.Resize(rowsize:=10000, columnsize:=Tbl.Range.Columns.Count).Clear

Tbl.Range.SpecialCells(xlCellTypeVisible).Copy Dest

Tbl.AutoFilter.ShowAllData
        
End Sub

EDIT: to delete rows from original table

Option Explicit
Sub DeleteTblRows()
    Dim Tbl As ListObject
    Dim idCol As Long
    Dim I As Long
      
Set Tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Events")
idCol = Tbl.ListColumns("Time").Index

For I = Tbl.ListRows.Count To 1 Step -1
    If Tbl.ListRows(I).Range(idCol).Value2 > CDbl(TimeSerial(7, 45, 0)) Then
        Tbl.ListRows(I).Delete
    End If
Next I

End Sub

Answer 2

This is a very bodged solution, but this seems to have worked.

I’ve put a formula in a hidden column that looks at if the time in the Time column is >07:45 and if it is, it puts “DEL” in the hidden column.

=IF(E4>”07:45”,”DEL”,” “)

I then use the second macro in my original question to delete any table rows in the hidden column that contain “DEL”.

Finally, I use the first macro in my original question to delete any remaining empty cells.

Answer 3

Delete Excel Table (ListObject) Rows Conditionally

Sub DeleteAfter0745()
    
    Dim drg As Range
    
    With ThisWorkbook.Sheets("Sheet1").ListObjects("Events").DataBodyRange
        ' Write the column values to an array.
        Dim rCount As Long: rCount = .Rows.Count
        Dim Data()
        With .Columns(.ListObject.ListColumns("Time").Index)
            If rCount = 1 Then
                ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
            Else
                Data = .Value
            End If
        End With
        ' Combine the matching rows into a range.
        Dim gtTime As Date: gtTime = TimeValue("07:45")
        Dim r As Long, drCount As Long
        For r = 1 To rCount
            If Data(r, 1) > gtTime Then
                If drg Is Nothing Then
                    Set drg = .Rows(r)
                Else
                    Set drg = Union(drg, .Rows(r))
                End If
                drCount = drCount + 1
            End If
        Next r
    End With

    ' Delete the matching rows.
    If drg Is Nothing Then
        MsgBox "There was nothing to delete.", vbExclamation
    Else
        drg.Delete xlShiftUp
        MsgBox drCount & " row" & IIf(drCount = 1, "", "s") & " deleted.", _
            vbInformation
    End If
    
End Sub