Preserve Pivot Table when Source Data Removed

[omagoodness]

I have a small table (tblTips) that collects data from a userform for managing employee tips payable. Data is entered every day for a week. I have a pivot table that filters and summarizes the data which is then automatically sent to the individual responsible for distribution of the tips to employees.
After the data from the pivot table is sent, I want the table data (source data) to clear but keep the pivot table structure in place for the next week.

This is the code I am using to clear the contents of the source data (tblTips). When I clear the source data, the pivot table gets deleted. Is there a way to prevent this?

Sub ClearTips()
Dim ws As Worksheet, pt As PivotTable, TipTbl As ListObject
Set ws = Sheets("Tip Calculator")
Set TipTbl = ws.ListObjects("tblTips")
On Error Resume Next

'clear the period from and to dates
If ws.ProtectContents = True Then
ws.Unprotect ("**********")
ws.Range("AG4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
ws.Range("AI4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
End If
'delete the table rows
Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Tip Calculator")
        If .ListObjects.Count > 0 Then
            With .ListObjects("tblTips")
                While .ListRows.Count > 0               'Delete all rows except first
                    .ListRows(.ListRows.Count).Delete
                Wend
            End With
        End If
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

ws.Protect ("************")

End Sub

 

[igold]

I basically ran your code, except that I changed how the Table gets cleared, and the PivotTable I had whose source data was that table did not change. I did not have any date cells to clear but I don't think that is relevant...

Sub ClearTips()

    Dim ws As Worksheet, pt As PivotTable, TipTbl As ListObject
    
    Set ws = Sheets("Tip Calculator")
    Set TipTbl = ws.ListObjects("tblTips")
    On Error Resume Next
    
    'clear the period from and to dates
    If ws.ProtectContents = True Then
        ws.Unprotect ("**********")
        ws.Range("AG4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
        ws.Range("AI4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
    End If
    'delete the table rows
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Delete all table rows except first row
    With TipTbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With
    
    'Clear out data from first table row
    TipTbl.DataBodyRange.Rows(1).ClearContents
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ws.Protect ("************")

End Sub

 

[omagoodness]

I basically ran your code, except that I changed how the Table gets cleared, and the PivotTable I had whose source data was that table did not change. I did not have any date cells to clear but I don't think that is relevant...

Sub ClearTips()

    Dim ws As Worksheet, pt As PivotTable, TipTbl As ListObject
   
    Set ws = Sheets("Tip Calculator")
    Set TipTbl = ws.ListObjects("tblTips")
    On Error Resume Next
   
    'clear the period from and to dates
    If ws.ProtectContents = True Then
        ws.Unprotect ("**********")
        ws.Range("AG4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
        ws.Range("AI4").SpecialCells(xlCellTypeConstants).ClearContents ' date cell
    End If
    'delete the table rows
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Delete all table rows except first row
    With TipTbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With
   
    'Clear out data from first table row
    TipTbl.DataBodyRange.Rows(1).ClearContents
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ws.Protect ("************")

End Sub

Perfectr. Thank you so much.

 

[igold]

You're welcome, I was happy to help. Thanks for the feedback.