Copy Iteration Issue

August 2, 2022

The script below triggers every couple milliseconds due to the Worksheet Calculate event and then copies from my Pivot Table to the Chart Helper. Script works great but when it copies the next iteration of data it pastes it after the original data set it just copied.

I need it to continuously paste over the original data set. Example if the original data set copies to A1:A15 I want it to replace A1:A15 not keep A1:A15 then add the new refreshed data set to A16:A30.

I suspect this line is the culprit Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value

    Private Sub Worksheet_Calculate()
    
    If Not Worksheets("Dashboard").ToggleButton1.Value Then Exit Sub
    
    Dim chPivot As PivotCache
    On Error GoTo SafeExit
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        For Each chPivot In ActiveWorkbook.PivotCaches
          chPivot.Refresh
        Next chPivot
    
        With ThisWorkbook.Sheets("Data Breakdown").PivotTables("PivotTable1").PivotFields("Price").DataRange
             ThisWorkbook.Sheets("Chart Helper").Cells(Rows.Count, 1).End(xlUp). _
                   Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
        With ThisWorkbook.Sheets("Data Breakdown").PivotTables("PivotTable1").PivotFields("Cost").DataRange
             ThisWorkbook.Sheets("Chart Helper").Cells(Rows.Count, 2).End(xlUp). _
                   Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
        End With
        End With
        
    SafeExit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

>Solution :

Assuming your data either gets larger or stays the same size then you just always need to paste data into the exact same cell to overwrite prior pastes.

i.e. replace .Cells(Rows.Count, 1).End(xlUp).Offset(1) with Range("A1")

You also need to separate your with statements. It can become ambiguous which object is being referenced when many are nested. Lastly, remove the column resize. You only need to resize the row here.

Your code could also be cleaned up a little by creating some Worksheet variables

Private Sub Worksheet_Calculate()
    
If Not Worksheets("Dashboard").ToggleButton1.Value Then Exit Sub

Dim db As Worksheet: Set db = ThisWorkbook.Sheets("Data Breakdown")
Dim ch As Worksheet: Set ch = ThisWorkbook.Sheets("Chart Helper")
Dim chPivot As PivotCache

On Error GoTo SafeExit
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
        For Each chPivot In ActiveWorkbook.PivotCaches
          chPivot.Refresh
        Next chPivot
        
       'Value transfer 'PRICE' to A1
        With db.PivotTables("PivotTable1").PivotFields("Price").DataRange
             ch.Range("A1").Resize(.Rows.Count).Value = .Value
        End With
        
        'Value transfer 'COST' to B1  
        With db.PivotTables("PivotTable1").PivotFields("Cost").DataRange
             ch.Range("B1").Resize(.Rows.Count).Value = .Value
        End With

SafeExit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub