VBA code to delete a line in a table

[dpaton05]

I have some code that is meant to delete a row and shift the cells up but it doesn't shift the cells up. If it is the last row in the table, I just want it to clear the contents.

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(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
                    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
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
    Application.EnableEvents = True
    'ActiveSheet.Protect Password:="npssadmin"
End Sub

Could someone help me adjust this code please so it also deletes a row and then shifts the rows up?

 

[Michael M]

Hi Dave
Haven't we solved this issue previously ???

 

[dpaton05]

Thanks for reminding me Michael. I am trying to get a part of my costing tool working, which has a part identical to the quoting tool, what you helped me with. Since you reminded me that it works already on that sheet, I just used the code for it and it worked.


Thanks Michael,
Dave

 

[dpaton05]

I am still having problems. It is now saying no cells found when I have a cell in the row I want deleted selected.

This is my code

Sub DelSelectCostingRow_new()
    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
                rng.Delete xlShiftUp
            End If
        End With
        With Worksheets("Costing_tool")
            
        End With
    Application.EnableEvents = True
    'ActiveSheet.Protect Password:="npssadmin"
End Sub

 

[dpaton05]

sorry, wrong code.

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(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
                    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
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
    Application.EnableEvents = True
    'ActiveSheet.Protect Password:="npssadmin"
End Sub

 

[Michael M]

The code in Post #4 is the one used in Version 12.7 of your workbook....and it works fine for me !

 

[dpaton05]

Actually, I went back to a previous version and it works fine for me now, thanks.