VBA Delete Table Rows Given Criteria

[Damien Hartzell]

This code is simply trying to remove entries from a table prior to 12 months from today's date. I keep getting a 1004 error that points to the following: "Set rng = ActiveSheet.Range(tblnm & "[[#Headers],[Name]]")". The table headers beging are the Range H15:M15. The rows vary, so the range is dynamic. I'm pretty new to VBA, so I'm confused as to what the error is trying to tell me. Anyone able to provide a fix?

Function ActiveTable(rng As Range) As ListObject

    Dim rv As ListObject
    If rng Is Nothing Then Exit Function
    For Each rv In rng.Parent.ListObjects
        If Not Intersect(rng, rv.Range) Is Nothing Then
            Set ActiveTable = rv
            Exit Function
        End If
    Next rv

End Function

Sub Reset12Month()

    If MsgBox("Are you sure you want to remove absences prior to 12 months before today's date? (If Non-Union, this will only include FMLA. If Union, this will include all absence entries.)", vbYesNo + vbQuestion) = vbNo Then End

    Range("H15").Select

    Dim tbl As ListObject, tblnm As String, rng As Range

    Set tbl = ActiveTable(ActiveCell)
    tblnm = tbl.Name
    
    If tbl Is Nothing Then Exit Sub
    
    Set rng = ActiveSheet.Range(tblnm & "[[#Headers],[Name]]")

    'ActiveTable = ActiveCell.ListObject.Name
                    'With Range(ActiveTable).ListObject
                    With rng
                    ''
                        Range("H15:M15").Select
                        Range(Selection, Selection.End(xlDown)).Select
                    End With
                    
        'Delete all table rows prior to 12 months of current date
        With tbl.DataBodyRange
            If .Cells(2, H).Value < .Formula = "=EDATE(TODAY(), -12)" Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
    
End Sub

 

[igold]

This simple code will look at a table that is named "Table15" and delete all rows whose value in the first column of the table are more than a year old from today date.
I am assuming however that the dates you are looking for reside in the first column of your table.

Sub tblDate()

    Dim tbl As ListObject
    Dim i As Long
    
    Set tbl = ActiveSheet.ListObjects("Table15")
    For i = 1 To tbl.ListRows.Count
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
    
End Sub

 

[igold]

I inadvertantly neglected to count from the bottom up (a pre-requisite for deleting rows). This is a corrected version...

Sub tblDate()

    Dim tbl As ListObject
    Dim i As Long
    
    Set tbl = ActiveSheet.ListObjects("Table15")
    For i = tbl.ListRows.Count To 1 Step -1
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
    
End Sub

 

[Damien Hartzell]

I inadvertantly neglected to count from the bottom up (a pre-requisite for deleting rows). This is a corrected version...

Sub tblDate()

    Dim tbl As ListObject
    Dim i As Long
   
    Set tbl = ActiveSheet.ListObjects("Table15")
    For i = tbl.ListRows.Count To 1 Step -1
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
   
End Sub

Thanks, igold! I do have one stipulation. Since this Workbook will contain multiple sheets with the same Macros, I do need to make reference to the current sheet's Table without naming it. Do you know how to do that?

 

[igold]

How many tables are on each sheet. If there is only one table per sheet it could be referenced as follows:

Set tbl = ActiveSheet.ListObjects(1)

If there is more than one table per sheet you would have to use a different strategy. Your data will dictate what code would work for you...

 

[Damien Hartzell]

Perfect! Yes. there is only one table per sheet. Okay. I'm going in. Will reply with confirmation shortly. Thank you!

 

[Damien Hartzell]

How many tables are on each sheet. If there is only one table per sheet it could be referenced as follows:

Set tbl = ActiveSheet.ListObjects(1)

If there is more than one table per sheet you would have to use a different strategy. Your data will dictate what code would work for you...

Okay. It's only highlighting the range and not deleting any rows. It's at least highlighting the appropriate range. I'm attaching an image of the sheet. The table headers begin are H15:M15. Here's what I changed the code to:

Sub Reset12Month()

    If MsgBox("Are you sure you want to remove absences prior to 12 months before today's date? (If Non-Union, this will only include FMLA. If Union, this will include all absence entries.)", vbYesNo + vbQuestion) = vbNo Then End

    Range("H16").Select

    Dim tbl As ListObject, tblnm As String, rng As Range

    Set tbl = ActiveSheet.ListObjects(1)
    tblnm = tbl.Name
    
    If tbl Is Nothing Then Exit Sub
                    
        'Delete all table rows prior to 12 months of current date
    For i = tbl.ListRows.Count To 1 Step -1
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
    
End Sub

 

[igold]

I am a little confused. Nothing in the code should highlight the table. Also, in your picture you do not show the entire table, the part of the table that you do show does not have any dates that meet the criteria for deletion, namely any date that is older than 06/11/2023

Also, it is not really important, but why this line of code:

Range("H16").Select

Additionallly, it makes no difference where the table is located on the sheet, so the address of the Header Row serves of no use...

I ran your code on my sheet and it worked fine. I did have to declare i as long. You may want to use "Option Explicit" in you coding, it is a good coding practice...

 

[Damien Hartzell]

How many tables are on each sheet. If there is only one table per sheet it could be referenced as follows:

Set tbl = ActiveSheet.ListObjects(1)

If there is more than one table per sheet you would have to use a different strategy. Your data will dictate what code would work for you...

Okay. It's only highlighting the range and not deleting any rows. It's at least highlighting the appropriate range. I'm attaching an image of the sheet. The table headers begin are H15:M15. Here's what I changed the code to:

Sub Reset12Month()

    If MsgBox("Are you sure you want to remove absences prior to 12 months before today's date? (If Non-Union, this will only include FMLA. If Union, this will include all absence entries.)", vbYesNo + vbQuestion) = vbNo Then End

    Range("H16").Select

    Dim tbl As ListObject, tblnm As String, rng As Range

    Set tbl = ActiveSheet.ListObjects(1)
    tblnm = tbl.Name
   
    If tbl Is Nothing Then Exit Sub
                   
        'Delete all table rows prior to 12 months of current date
    For i = tbl.ListRows.Count To 1 Step -1
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
   
End Sub

I am a little confused. Nothing in the code should highlight the table. Also, in your picture you do not show the entire table, the part of the table that you do show does not have any dates that meet the criteria for deletion, namely any date that is older than 06/11/2023

Also, it is not really important, but why this line of code:

Range("H16").Select

Additionallly, it makes no difference where the table is located on the sheet, so the address of the Header Row serves of no use...

I ran your code on my sheet and it worked fine. I did have to declare i as long. You may want to use "Option Explicit" in you coding, it is a good coding practice...

Haha! Let me retest that. I'm a dunce.

 

[Damien Hartzell]

Okay. It's only highlighting the range and not deleting any rows. It's at least highlighting the appropriate range. I'm attaching an image of the sheet. The table headers begin are H15:M15. Here's what I changed the code to:

Sub Reset12Month()

    If MsgBox("Are you sure you want to remove absences prior to 12 months before today's date? (If Non-Union, this will only include FMLA. If Union, this will include all absence entries.)", vbYesNo + vbQuestion) = vbNo Then End

    Range("H16").Select

    Dim tbl As ListObject, tblnm As String, rng As Range

    Set tbl = ActiveSheet.ListObjects(1)
    tblnm = tbl.Name
  
    If tbl Is Nothing Then Exit Sub
                  
        'Delete all table rows prior to 12 months of current date
    For i = tbl.ListRows.Count To 1 Step -1
        If tbl.DataBodyRange(i, 1) < Date - 365 Then
            tbl.ListRows(i).Delete
        End If
    Next
  
End Sub

Haha! Let me retest that. I'm a dunce.

Boom! You're a genius igold! Thank you much!