Find PivotTable reports that overlap each other

 2012-03-06    Workbooks    7    111

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)
                                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
        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
        ActiveWindow.FreezePanes = True
    End If
End Sub

Leave a comment:

Your comment will only be published after it has been moderated and found spam free.
Your e-mail address will only be used to display your Gravatar.

ochnk | 2017-02-13 06:43:47 (GMT)

I am not sure how come this old post is not easily found in Google, but this is just too good! It's super light and just does the job.

Amazing job, thank you so much!

Marcus Stemberger | 2016-11-19 19:37:39 (GMT)

Absolute WOW!!!

George W Hennessy | 2016-09-09 15:08:18 (GMT)

You belong in the Excel Hall of Fame for this!! Truly a gift. Thank you!!!

Dan00 | 2012-09-06 20:27:34 (GMT)

Wow. This code is epic. I have over 50 pivot tables and a dozen sheets so this code really saved my bacon. This is the number one problem I have with maintaining this workbook so you have saved me probably 100 hours of snafu checking just with this checker. Thank you so very much.


Joe | 2012-08-29 10:16:37 (GMT)


Aslam | 2012-06-25 12:21:25 (GMT)

Amazing code. I was going nuts with the error msg "Pivot table cannot overlap another pivot" - in a workbook with multiple pivots. This one saved my day!

Zach | 2012-06-05 00:58:25 (GMT)

This code was a God-send! It helped me solve an "Over-lapping Pivot Table" problem I had been working on for hours. Thanks for this terrific snippet EDC!