vba to delete a selected row in a table

[dpaton05]

• I have some code that is meant to allow a row or a cell in that row to be selected and the row will be deleted upon a button click. If it is the first row in the table, I just need it cleared. I am sure the code used to work, but for some reason, it has stopped working.
• What it does now is it clears the first row, even if you have another row selected.
• I also don't want a run time error to appear if no cells are found.

Here is the code I have. Can someone help me please?

Sub DelSelectCostingRow()
    ActiveSheet.Unprotect Password:="npssadmin"
        Dim rng As Range
        Dim tbl As ListObject
            Set tbl = ActiveSheet.ListObjects("tblCosting")
        On Error Resume Next
        With Selection.Cells
            Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
                On Error GoTo 0
                If rng Is Nothing Then
                    MsgBox "Please select a cell within a row that you want to delete.", vbCritical
                Else
                    ActiveCell.EntireRow.Select
                    If ActiveSheet.ListObjects("tblCosting").ListRows(1).Range.Select Then
                        tbl.DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
                    Else
                        rng.Delete xlShiftUp
                    End If
                End If
        End With
    Application.EnableEvents = True
End Sub

 

[dpaton05]

But wouldn't this code clear the contents of the row already without the formulas

Sub DelSelectCostingRow()
    ActiveSheet.Unprotect Password:="npssadmin"
        Dim rng As Range
        
        On Error Resume Next
        With Selection.Cells(1)
            Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
            On Error GoTo 0
            If rng Is Nothing Then
                MsgBox "Please select a cell within a row that you want to delete.", vbCritical
            Else
                If ActiveCell.Row = 5 Then
                Rows(5).ClearContents
                Else
                rng.Delete xlShiftUp
                End If
            End If
        End With

    Application.EnableEvents = True

End Sub

 

[Michael M]

I think we're getting a little confused...
The code I provided answers the initial question of clearing the contents of the row IF it is the only row available !!
OR deleting an entire row if not.

BUT....see post #10 to hopefully solve either issue, by either clearing the range OR clearing the entire row AND then you can reinsert the formual with the other snippet

 

[dpaton05]

With that code I tried to copy 3 rows from NPSS_quote_sheet and then tried to delete certain rows within costing_tool. Within costing_tool, if I select row 6 or 7 and press delete selected row, the rows delete as I want, shifting the other rows up but if I press delete row on row 5 it will only clear it and won't shift the other rows up if there are rows under it.

 

[Michael M]

OK...this then....

Private Sub cmdDelSelectRow_Click()
    ActiveSheet.Unprotect Password:="npssadmin"
        Dim rng As Range, lr As Long
        lr = Cells(Rows.Count, "A").End(xlUp).Row
        On Error Resume Next
        With Selection.Cells(1)
            Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
            On Error GoTo 0
            If rng Is Nothing Then
                MsgBox "Please select a cell within a row that you want to delete.", vbCritical
            Else
                If ActiveCell.Row = 5 And lr = 5 Then
                Range("A5:H5").ClearContents
                Else
                rng.Delete xlShiftUp
                End If
            End If
        End With
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
    Application.EnableEvents = True
    'ActiveSheet.Protect Password:="npssadmin"
End Sub

 

[dpaton05]

I would rather just clear the first row instead of deleting and reinserting formulas as there are quite a few formulas. Thanks Michael.

 

[dpaton05]

Thank you for that Michael, that is perfect!!

 

[Michael M]

Glad to help....