Find PivotTable reports that overlap each other

 2012-03-06    PivotTables    10    286

The error message "A PivotTable report cannot overlap another PivotTable report" has annoyed me lately, especially when you try to update PivotTables in a workbook with lots of worksheets with multiple PivotTables. Excel is not very helpful since the error message doesn't include any hints about where those conflicting PivotTables are. With the macros below you can find those conflicting PivotTables that Excel insists on keeping a secret for you. To solve the problem you need to make more space (rows/columns) between the PivotTables that overlap each other, or you can move them to separate worksheets.

Function GetPivotTableConflicts(wb As Workbook) As Collection
' returns a collection with information about pivottables that overlap or intersect each other
Dim ws As Worksheet, i As Long, j As Long, strName As String
    If wb Is Nothing Then Exit Function

    Set GetPivotTableConflicts = New Collection
    With wb
        For Each ws In .Worksheets
            With ws
                strName = "[" & .Parent.Name & "]" & .Name
                Application.StatusBar = "Checking PivotTable conflicts in " & strName & "..."
                If .PivotTables.Count > 1 Then
                    For i = 1 To .PivotTables.Count - 1
                        For j = i + 1 To .PivotTables.Count
                            If OverlappingRanges(.PivotTables(i).TableRange2, .PivotTables(j).TableRange2) Then
                                GetPivotTableConflicts.Add Array(strName, "Intersecting", _
                                    .PivotTables(i).Name, .PivotTables(i).TableRange2.Address, _
                                    .PivotTables(j).Name, .PivotTables(j).TableRange2.Address)
                            Else
                                If AdjacentRanges(.PivotTables(i).TableRange2, .PivotTables(j).TableRange2) Then
                                    GetPivotTableConflicts.Add Array(strName, "Adjacent", _
                                        .PivotTables(i).Name, .PivotTables(i).TableRange2.Address, _
                                        .PivotTables(j).Name, .PivotTables(j).TableRange2.Address)
                                End If
                            End If
                        Next j
                    Next i
                End If
            End With
        Next ws
        Set ws = Nothing
        Application.StatusBar = False
    End With
    If GetPivotTableConflicts.Count = 0 Then Set GetPivotTableConflicts = Nothing
End Function

Function OverlappingRanges(objRange1 As Range, objRange2 As Range) As Boolean
    OverlappingRanges = False
    If objRange1 Is Nothing Then Exit Function
    If objRange2 Is Nothing Then Exit Function
    
    If Not Application.Intersect(objRange1, objRange2) Is Nothing Then
        OverlappingRanges = True
    End If
End Function

Function AdjacentRanges(objRange1 As Range, objRange2 As Range) As Boolean
    AdjacentRanges = False
    If objRange1 Is Nothing Then Exit Function
    If objRange2 Is Nothing Then Exit Function
    
    With objRange1
        If .Top + .Height = objRange2.Top Then
            AdjacentRanges = True
        End If
        If .Left + .Width = objRange2.Left Then
            AdjacentRanges = True
        End If
    End With
    With objRange2
        If .Top + .Height = objRange1.Top Then
            AdjacentRanges = True
        End If
        If .Left + .Width = objRange1.Left Then
            AdjacentRanges = True
        End If
    End With
End Function
The macro below shows how you can use the functions above.
Sub ShowPivotTableConflicts()
' creates a list with all pivottables in the active workbook that conflicts with each other
Dim coll As Collection, i As Long, varItems As Variant, r As Long
    If ActiveWorkbook Is Nothing Then Exit Sub
    
    Set coll = GetPivotTableConflicts(ActiveWorkbook)
    If coll Is Nothing Then
        MsgBox "No PivotTable conflicts in the active workbook!", vbInformation
    Else
        Workbooks.Add ' create a new workbook
        Range("A1").Formula = "Worksheet:"
        Range("B1").Formula = "Conflict:"
        Range("C1").Formula = "PivotTable1:"
        Range("D1").Formula = "TableAddress1:"
        Range("E1").Formula = "PivotTable2:"
        Range("F1").Formula = "TableAddress2:"
        Range("A1").CurrentRegion.Font.Bold = True
        r = 1
        For i = 1 To coll.Count
            r = r + 1
            varItems = coll(i)
            Range("A" & r).Formula = varItems(0)
            Range("B" & r).Formula = varItems(1)
            Range("C" & r).Formula = varItems(2)
            Range("D" & r).Formula = varItems(3)
            Range("E" & r).Formula = varItems(4)
            Range("F" & r).Formula = varItems(5)
        Next i
        Range("A1").CurrentRegion.EntireColumn.AutoFit
        Range("A2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select
    End If
End Sub