Moving location of pivot table(s)

Question

How can I move the location of a pivot table in order to ensure it will not overlap with another pivot table below on refresh?

I have 10 pivot tables whose column span is always equal to A:E.
The rows will dynamically update as the pivots refresh.
I want there to be 2 blank rows before each new pivot table starts so I am using the following workaround

(other questions indicate you cannot directly insert rows as a pivot table refreshes to stop them from overlapping which is the root problem I am trying to curb/workaround)

1. Disable auto-calculation
2. Loop through all pivots (pvt)
3. Offset pivot by (LRow, 6) .... New column span is now G:K
4. Refresh Pivot (which will update LRow on next loop as the table resizes)
5. Next Pivot
6. Re-enable auto-calculate & delete Columns A:F which means the pivots will be back in their original starting point spanning columns A:E while leaving 2 empty rows in-between each pivot.

The problem is with pvt.PivotTableWizard TableDestination:=Range("G" & lrow) which does not move the pivot table (or appear to do anything).

Sub MovePivots()

Dim pvt As PivotTable, LRow As Long

Application.Calculation = xlCalculationManual
    For Each pvt In PivotTables
        LRow = Range("G" & Rows.Count).End(xlUp).Offset(2).Row
        pvt.PivotTableWizard TableDestination:=Range("G" & LRow)
        pvt.PivotCache.Refresh
    Next pvt
Application.Calculation = xlCalculationAutomatic

    Range("A:F").EntireColumn.Delete

End Sub

Answer 1

As an alternative to moving PivotTables before the refresh to avoid errors, how about another route: Refresh the Pivots, see if an error occurs, and then move the ones that overlap as a result.

Here's some code I wrote some time back to identify overlaps, if you elect to go down this route.

Sub FindPivotOverlaps()

Dim ws As Worksheet
Dim pt              As PivotTable
Dim pt2             As PivotTable
Dim lo              As ListObject
Dim rOffset         As Range
Dim cell            As Range
Dim sMsg            As String


For Each ws In ActiveWorkbook.Worksheets
    For Each pt In ws.PivotTables
        With pt.TableRange2
            Set rOffset = Union( _
                                .Offset(pt.TableRange2.Rows.Count, 0).Resize(1), _
                                .Offset(0, pt.TableRange2.Columns.Count).Resize(pt.TableRange2.Rows.Count, 1))
        End With
        'Test for ListObject collision
        Set lo = Nothing
        On Error Resume Next
        Set lo = rOffset.ListObject
        On Error GoTo 0
        If Not lo Is Nothing Then
            sMsg = sMsg & lo.Name & vbTab & "'" & lo.Parent.Name & "'!" & lo.DataBodyRange.Address & vbNewLine
        Else
            'Test for PivotTable collision
            For Each cell In rOffset
                Set pt2 = Nothing
                On Error Resume Next
                Set pt2 = cell.PivotTable
                On Error GoTo 0
                If Not pt2 Is Nothing Then
                    sMsg = sMsg & pt2.Name & vbTab & "'" & pt2.Parent.Name & "'!" & pt2.TableRange2.Address & vbNewLine
                    Exit For
                End If
            Next cell
        End If

    Next pt
Next ws

If sMsg = "" Then sMsg = "No overlaps found!"
MsgBox sMsg

End Sub

Answer 2

1. The PivotTable.PivotTableWizard Method creates and returns a PivotTable object - you can't use it to loop through existing pivot tables and move them.
2. The PivotTable.TableRange2 Property returns a Range object that represents the range containing the entire PivotTable report, including page fields.

I took a slightly different approach:

1. Insert 5 new columns to move all pivot tables to the right
2. Loop through all the pivot tables, Cutting them and moving to Column A and then refreshing.

In testing, Excel did not necessarily work from top to bottom, and my pivot tables were thrown out of order. In that case, you could create an Array of their names and loop through them that way.

Sub RefreshPivotsAvoidingOverlap()
    Dim pvt As PivotTable
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim lRow As Long

    ws.Columns("A:E").Insert

    For Each pvt In ws.PivotTables
        lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 3

        With pvt.TableRange2
            .Cut ws.Cells(lRow, 1)
            pvt.PivotCache.Refresh
        End With
    Next pvt

End Sub

Answer 3

What I ended up using:

This will refresh pivots while keeping the desired location & spacing between each pivot without throwing an error due to overlapping. To control the order that the pivots are handle, use an array (enter the pivot table names in the order in wish you want them to be handled).

With screen updating toggled off, it just looks like the pivots are refreshing while dynamically adding/removing rows to keep desired spacing.

Option Explicit

Sub Refresh_Pivots()

Dim OTC As Worksheet: Set OTC = ThisWorkbook.Sheets("OTC")
Dim LRow As Long, i As Long, Pvts
Pvts = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4", "PivotTable5")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    For i = LBound(Pvts) To UBound(Pvts)
        LRow = OTC.Range("N" & OTC.Rows.Count).End(xlUp).Offset(3).Row
        OTC.PivotTables(Pvts(i)).TableRange2.Cut OTC.Range("M" & LRow)
        OTC.PivotTables(Pvts(i)).PivotCache.Refresh
    Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

OTC.Range("B:L").EntireColumn.Delete

End Sub

Thanks @BigBen & @jeffreyweir for useful solutions/comments/links