Modify code so that formulas in table rows are not deleted

[dpaton05]

I have the following code:

Sub DeleteCostingLine()
    Dim ws As Worksheet
    Dim tbl As ListObject
        Set ws = ActiveSheet
        Set tbl = ws.ListObjects("tblCosting")

    tbl.ListRows(tbl.ListRows.Count).Delete
    Worksheets("Costing_tool").Range("AB5").Value = "1"
End Sub

This deletes everything in the selected row in a table but I don't want it to delete formulas, can someone help me with changing this code please?

 

[dpaton05]

Actually, I just tried it again and it seemed to work.

 

[dpaton05]

Actually, I put up the wrong code, this is the code. Could someone change this so formulas are not deleted please?

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

 

[dpaton05]

I tried to change it myself but it didn't work. I just thought that I could check if it was the first row in the table and if it was, I would just clear the contents but if it was a later row, the row would just be deleted.

This is my attempt, can someone let me know where I went wrong please as I am not very sure of the syntax?

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
                    If .Row(1) = True 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]

So you don't want to delete the row, you just want to clear all contents, EXCEPT formulas ??
Which columns in the row contain formulas ??

 

[dpaton05]

The formula deletes everything in the row and that is ok as it is a table but when it gets to the only row left in the table, it deletes the formulas in the cells and as there is no row above it with the formulas in it, when I copy from quoting tool, it doesn't copy in and have the formulas auto populate.

Maybe I could have code in cmdSend that puts the formula in each column that has one for the rows that are copied?

 

[dpaton05]

I worked it out with the following 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]

Hmmm, seems to me you're getting the hang of this VBA thing...

I'm not sure you need the .Select line though

ActiveCell.EntireRow.Select