Modify code so that formulas in table rows are not deleted

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,403
I have the following code:
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?
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,403
Actually, I put up the wrong code, this is the code. Could someone change this so formulas are not deleted please?

Code:
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,403
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?

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
                    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

Well-known Member
Joined
Oct 27, 2005
Messages
18,882
Office Version
2013
Platform
Windows
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,403
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,403
I worked it out with the following code:

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

Well-known Member
Joined
Oct 27, 2005
Messages
18,882
Office Version
2013
Platform
Windows
Hmmm, seems to me you're getting the hang of this VBA thing...(y)

I'm not sure you need the .Select line though
Code:
ActiveCell.EntireRow.Select
 

Watch MrExcel Video

Forum statistics

Threads
1,099,583
Messages
5,469,518
Members
406,656
Latest member
Kriscrawford76

This Week's Hot Topics

Top