I need a way of undoing a macro that deletes all lines

[dpaton05]

I have a spreadsheet with a table that is used for storing quotes that has a delete all table lines button. My supervisor needs a way to undo or restore if the delete all lines button is clicked. The quote could be up to 100 pages long, so re-entering all that information is just not practical. Can someone give me some ideas on how I could achieve this please as I thought of possibly saving a copy of the file before the delete all lines code is run but there may be a better way of doing this?


Here is the delete all lines code:

Sub cmdDeleteAllQuoteLines()
    'Deleting The Data In A Table
    Dim tbl As ListObject
    Dim cell As Range
    
    Set tbl = Sheets("NPSS_quote_sheet").ListObjects("npss_quote")
    'Delete all table rows except first row
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete

        End If
        'Clear the contents, but not delete the formulas
        For Each cell In tbl.ListRows(1).Range.Cells
            If Not cell.HasFormula Then
                cell.Value = ""
            End If
        Next
    End With
        With ThisWorkbook.Worksheets("NPSS_quote_sheet")
            .ListObjects("npss_quote").DataBodyRange.Columns(13).Value = 1 - 0.1 * ActiveSheet.chkIncrease.Value
            .Rows(11).Font.Bold = False
        End With
    
    'ListObjects("NPSS_quote").ListColumns("10%Increase").DataBodyRange.Value = "1"
End Sub

Thanks,
Dave

 

[dpaton05]

But I don't want it to add to a new sheet called backup and exit if the sheet exists. I want to paste over the contents of the backup sheet.

 

[Michael M]

Ok, as I mentioned in the last post

Rather than using the create Backup Sheet code

 

[dpaton05]

How do I do this Michael?

 

[Michael M]

This should be well within your pay grade Dave !

I'd suggest manually making a copy of the sheet called "NPSS_quote_sheet" rename it "Backup". Then delete the rows from the Backup sheet up to the header.
Then when running the delete lines macro ONLY copy the range from below the headers to the last row, across to the backup sheet

Remember the macro recorder is your friend !

 

[dpaton05]

Then when running the delete lines macro ONLY copy the range from below the headers to the last row, across to the backup sheet

This is this bit that I am not sure how to do.

 

[dpaton05]

I tried to modify this code but I didn't work. I copied the sheet and then tried to update the references in the code but nothing would happen when I run this code to backup the entries. Is there something wrong with my code? For anyone else looking at this, I am just trying to copy all rows in my table npss_quote that is within my sheet NPSS_quote_sheet to a table called npss_quote_backup that is within my sheet Backup. If anyone else is looking at this, I am trying to copy all rows from a table called npss_quote in the sheet, NPSS_quote_sheet to a table called npss_quote_backup that is stored within the sheet Backup.

Private Sub cmdBackup_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim desWS As Worksheet, srcWS As Worksheet
        Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
        Set desWS = ThisWorkbook.Sheets("Backup")
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, x As Long, header As Range
        lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
        lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    With srcWS.Range("A:A,B:B,D:D,F:F,G:G,H:H")
        If lastRow2 < 5 Then
            lastRow2 = 5
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                    desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next i
            With desWS
                If .Range("A" & .Rows.Count).End(xlUp).Row > 11 Then
                    desWS.ListObjects.Item("npss_quote_backup").ListRows.Add
                    .ListObjects.Item("npss_quote_backup").DataBodyRange.Columns(1).NumberFormat = "dd/mm/yyyy"
                End If
                .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B6")
            End With
        Else
            lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
            desWS.ListObjects.Item("npss_quote_backup").ListRows.Add
            For i = 1 To .Areas.Count
                x = .Areas(i).Column
                Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                If Not header Is Nothing Then
                    srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                    desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next i
            With desWS
                .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
            End With
        End If
    End With
    desWS.ListObjects("npss_quote_backup").Sort.SortFields.Clear
    desWS.ListObjects("npss_quote_backup").Sort.SortFields. _
        Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With desWS.ListObjects("npss_quote_backup").Sort
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    
    With Application
        .CutCopyMode = False
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Dim oLst As ListObject
        Dim lr As Long, rng As Range
        lr = desWS.Cells(Rows.Count, "A").End(xlUp).Row
        For i = lr To 4 Step -1
            Set rng = desWS.Cells(i, 1)
            If WorksheetFunction.CountBlank(rng) = 1 Then
                desWS.Rows(i).Delete
            End If
        Next i
End Sub

Thanks guys