Deleting Unused Table Rows

Question

I have a sheet with 6 tables with each table using columns B:N. Column B contains hours from 1AM to 12AM per table. I need to delete all rows below the cells that contain a specific value on cell AF2. For example, AF2 contains 5PM. All rows below 5PM on column B on each table should be deleted. All tables have titles like first table is Cashiers, second table is Waiters, and so on and so forth.

This is what I have so far:

Set sh = Sheets("report")
valueToFind = sh.Range("AF2").Value

Do
Set Cell1 = sh.Range("B:B").Find(What:=valueToFind, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Cell1 Is Nothing Then Exit Do
Set Cell2 = sh.Range(Cell1.Address & ":B" & sh.UsedRange.Rows.Count).End(xlDown)
    If IsEmpty(Cell1.Offset(1, 0)) Then
        Exit Sub
    Else
        Rows(Cell1.Row & ":" & Cell2.Row).Delete
    End If
Loop

The problem with this code is that it also deletes the row with the time that's indicated on cell AF2, when it should move one cell down then delete starting that row down.

Any suggestions?

Answer 1

Please make a backup of your book before trying this code:

Read code's comments and adjust it to fit your needs. (Comment/Uncomment the line that deletes what's in previous range values)

EDIT: See the two versions below

Version 1

This code copies the values from the source sheet and then loops through the tables (listobjects) and deletes the rows below the one with time you're looking for

Public Sub CopyTablesDeleteRows()

    ' Declare objects
    Dim mainSheet As Worksheet
    Dim evalSheet As Worksheet

    Dim evalTable As ListObject

    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim filterCell As Range
    Dim foundCell As Range

    ' Declare other variables
    Dim mainSheetName As String
    Dim reportSheetName As String
    Dim sourceRangeAddress As String
    Dim filterCellAddress As String

    ' Adjust these next lines to fit your needs
    mainSheetName = "Main report"
    reportSheetName = "report"
    sourceRangeAddress = "B2:N84"
    filterCellAddress = "AF2"

    Set mainSheet = ThisWorkbook.Worksheets(mainSheetName)
    ' This is the source range where tables are located
    Set sourceRange = mainSheet.Range(sourceRangeAddress)

    Set evalSheet = ThisWorkbook.Worksheets(reportSheetName)
    Set destinationRange = evalSheet.Range(sourceRangeAddress)
    Set filterCell = evalSheet.Range(filterCellAddress)

    ' Delete previous values
    destinationRange.Clear

    ' Copy source range to destination
    sourceRange.Copy destinationRange

    ' Loop through each table in the worksheet
    For Each evalTable In evalSheet.ListObjects

        ' Find the filter cell value in the table's first column (see ListColumns(1) in next line)
        Set foundCell = evalTable.ListColumns(1).DataBodyRange.Find(What:=Format(filterCell.Value, "hh:mm AM/PM"), _
                                                                    LookIn:=xlValues, lookat:=xlWhole, _
                                                                    searchorder:=xlByRows, SearchDirection:=xlNext, _
                                                                    MatchCase:=False, SearchFormat:=False)
        ' If filter cell value is found inside table's column
        If Not foundCell Is Nothing Then

            ' Delete rows from that cell to the last one in table
            evalTable.DataBodyRange.Rows(foundCell.Row - evalTable.HeaderRowRange.Row + 1 & ":" & evalTable.DataBodyRange.Rows.Count).Delete
        End If

    Next evalTable

End Sub

Version 2

This code works with the copy paste values formats (meaning you loose the structured tables functionality), then finds the end and start rows according to the time value searched and finally delete the ranges (Code is long because the way you have positioned 12:00 AM at the bottom of the table and some tables don't have all day hours)

Public Sub DeleteRows()

    Dim reportSheet As Worksheet

    Dim reportSheetName As String
    Dim valueToFindRangeAddr As String
    Dim lookInColumn As String

    Dim valueToFind As Date

    Dim lastRow As Long
    Dim startRow As Long
    Dim endRow As Long

    Dim generalCounter As Long
    Dim counter As Long
    Dim rangeCounter As Long

    Dim deleteRangeRows() As Variant
    Dim rangeRows() As Variant

    reportSheetName = "report"
    valueToFindRangeAddr = "AF2"
    lookInColumn = "B"

    ' Initialize objects
    Set reportSheet = ThisWorkbook.Worksheets(reportSheetName)
    valueToFind = reportSheet.Range(valueToFindRangeAddr).Value2

    ' Get last cell with values in lookInColumn
    lastRow = reportSheet.Cells(reportSheet.Rows.Count, reportSheet.Columns(lookInColumn).Column).End(xlUp).Row

    If Format(valueToFind, "hh:mm AM/PM") = Format(TimeValue("12:00 AM"), "hh:mm AM/PM") Then
        MsgBox "Value to find is last time in tables"
        Exit Sub
    End If

    For generalCounter = lastRow To 1 Step -1

        ReDim Preserve deleteRangeRows(rangeCounter)
        startRow = 0
        endRow = 0

        ' Get row of last cell with time
        For counter = generalCounter To 1 Step -1
            If IsTime(reportSheet.Range(lookInColumn & counter).Value) = True Then
                endRow = counter
                Exit For
            End If
        Next counter

        ' Get row of cell with value to find
        For counter = endRow - 1 To 1 Step -1
            If reportSheet.Range(lookInColumn & counter).Value = valueToFind Then
                startRow = counter + 1
                Exit For
            ElseIf IsTime(reportSheet.Range(lookInColumn & counter).Value) = False Then
                Exit For
            End If
        Next counter

        If startRow > 0 And startRow <= endRow Then
            deleteRangeRows(rangeCounter) = Array(startRow, endRow)
            rangeCounter = rangeCounter + 1
            generalCounter = counter
        Else
            generalCounter = counter + 1
        End If



    Next generalCounter

    ' Delete rows ranges recorded
    For counter = 0 To UBound(deleteRangeRows) - 1

        startRow = deleteRangeRows(counter)(0)
        endRow = deleteRangeRows(counter)(1)

        reportSheet.Rows(startRow & ":" & endRow).Delete

    Next counter

    MsgBox "Finished"

End Sub

' Credits: https://stackoverflow.com/a/52805191/1521579
Function IsTime(Expression As Variant) As Boolean
    If IsDate(Expression) Then
        IsTime = (Int(CSng(CDate(Expression))) = 0)
    End If
End Function

Let me know if it works and remember to mark the answer to help others