VBA remove all records from master sheet while auto refreshing and auto archival

Hello VBA expert,

I found this forum today for VBA help and hope it will be resolved soon. I asked my query in some other forum and still waiting for the solution. I don't know whether this is the correct way to ask you.

This is a brief overview about my project with some sample record in attached sheet.

1)In the attached workbook, there is a master sheet ("MOU sheet") where data was entered dynamically by users.
2)A pivot table was created ("Pivot") from the master sheet and then from it, an interface was created in sheet "Final"
3) The Final sheet copied all the column data from pivot sheet. A validation rule was created on country column where user need to select a particular country name, then it display all columns from colA- col F.
4)The tricky part is that column G (Calendar date) was entered separately (editable) which means if the end user enter any date here, it reflects automatically on master sheet on col O.
e.g if country "China" is selected on "Final" sheet and enter date "12-JUN-2018" for product 7, then the same date is reflected on col O of "MOU sheet".
The macro is working fine.


My query is :- I used to refresh pivot table and archive data (only when col O is filled in MOU sheet) Manually. How can I do the same activity automatically only when I click the "Save" button in Final sheet.


Solution: I tried to keep both macro in "This workbook" sheet and hit save button. It's working fine but when I did the same process once again, all the records in "MOU sheet" vanishes automatically. Can you please help me how to proceed futher.

I used below code. Request to check why the records in master sheet deleted automatically after saving the button for second time.

Code:

---

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Application.Run ("archiving")
Application.Run ("RefreshPivotTables")
Application.ScreenUpdating = True
End Sub

---

Your archiving macro has this line:
.Offset(1).EntireRow.Delete
which deletes hidden rows too.
Change your Archiving macro to:

Code:

---

Sub archiving()
Dim rngTodelete As Range
With Sheets("MOU sheet").ListObjects("Table_MOU")
  .Range.AutoFilter Field:=15, Criteria1:="<>"
  On Error Resume Next
  Set rngTodelete = .DataBodyRange.SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rngTodelete Is Nothing Then
    .DataBodyRange.Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .AutoFilter.ShowAllData 'safer than .Range.AutoFilter Field:=15 for subsequent deletion.
    rngTodelete.Delete
  End If
End With
End Sub

---

Thanks P45cal but all the rows are hided automatically after clicking the save button. How can it be unhided.
Attaching the sheet once again. just click on the "save" button and see how all the rows hided.

Sorry!:

Code:

---

Sub archiving()
Dim rngTodelete As Range
With Sheets("MOU sheet").ListObjects("Table_MOU")
  .Range.AutoFilter Field:=15, Criteria1:="<>"
  On Error Resume Next
  Set rngTodelete = .DataBodyRange.SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rngTodelete Is Nothing Then
    .DataBodyRange.Copy Sheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .AutoFilter.ShowAllData    'safer than .Range.AutoFilter Field:=15 for subsequent deletion.
    rngTodelete.Delete
  End If
  .AutoFilter.ShowAllData    'safer than .Range.AutoFilter Field:=15 for subsequent deletion.
End With
End Sub

---

Thanks P45cal for your support. Its working fine now.