PivotTable refresh date history / flag new data since last refresh

[liambear88]

Hi

I'm trying to flag data that appears since the last time the report was refreshed. For example, if the sale date was 28/07/19, flag this row as "new since last refresh", if the record wasn't present on the last report version. Any ideas please, guys?

I've Googled about and looked through the forums a little, and have created a macro to show "last refresh date", with a plan to create a statement to say "if sale date after last refresh date, show a 1, but the "last refresh date" changes when the report is refreshed (this is now obvious to me).

Any ideas welcome

 

[pbornemeier]

One way to do that would be to modify the pivottable input data to include a column that would (automatically) update its row value with a date/time stamp when the row was created edited. This field could be added to the PT and if put in the PT PageField would be selected to show only rows that were after a desired date.

Assuming that your data had to occupy each cell in columns A:I the code below would update column J as soon as column I was changed.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(9)) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 10).Value = Now()
        Application.EnableEvents = True
    End If
End Sub

Another option would fill in blank cells in the DTS column when the PT was refreshed:

Option Explicit

Private Sub Worksheet_PivotTableBeforeCommitChanges( _
    ByVal TargetPivotTable As PivotTable, _
    ByVal ValueChangeStart As Long, _
    ByVal ValueChangeEnd As Long, Cancel As Boolean)

    Dim wksSource As Worksheet
    
    Set wksSource = Worksheets("Sheet1")     'Worksheet that contains the PT data
    Const lDTSColumn As Long = 10            'DateTime Stamp column on that worksheet
    
    Dim lLastRow As Long
    Dim rngCell As Range
    
    Application.EnableEvents = False
    With wksSource
        .AutoFilterMode = False
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next    'In case no blanks
        If Err.Number = 0 Then
            For Each rngCell In .Range(.Cells(2, lDTSColumn), .Cells(lLastRow, lDTSColumn)).SpecialCells(xlCellTypeBlanks)
                rngCell.Value = Now()
            Next
        End If
        On Error GoTo 0
    End With
    Application.EnableEvents = True
    
End Sub

Note that refreshing a PT does not automatically include any rows added since the SourceData was defined, only incorporates changes to that data. The following code will modify the source data to include the new rows:

Sub RefreshPivotTableSource()
    'XL 2007
    Dim lX As Long
    Dim sSourceSheet As String
    Dim sPivotTableSheet As String
    
    sSourceSheet = "Data"
    sPivotTableSheet = "PT"
    
    For lX = 1 To Worksheets(sPivotTableSheet).PivotTables.Count
        Worksheets(sPivotTableSheet).PivotTables(lX).ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
             sSourceSheet & "!" & ActiveWorkbook.Worksheets(sSourceSheet).Range("A1"). _
             CurrentRegion.Address(ReferenceStyle:=xlR1C1), Version:=[COLOR="#B22222"]xlPivotTableVersion10[/COLOR])
    Next
    
End Sub

You will have to change xlPivotTableVersion10 depending on what Excel version you are running

 

[liambear88]

thanks very much, the first suggestion is perfect.

Much appreciated

 

[pbornemeier]

Glad to help