CODEWITHSUNDEEP
vbapivot-table
vinit
vinit

Reputation: 85

Comparing grouped dates in two different pivot tables vba

I am trying to compare and filter dates, that are grouped weekly, in two different pivot tables in two different worksheet. I want to compare the dates in the two table and if they are the same then copy that grouped date and put it in another worksheet. The VBA code that I have is comparing all the dates within a month. For example:

            pivot table 1             pivot table 2
      10/15/2013 - 10/21/2013    10/15/2013-10/21/2013
      10/22/2013 - 10/28/2013    10/22/2013 - 10/28/2013 
      5/27/2014 - 6/2/2014       6/3/2014 - 6/9/2014

When I run the VBA I want to copy the first two sets of dates into another worksheet because they are the same and ignore the third set because they aren't. The number of dates in each table could be different. Here is the code I have so far

Sub Find()

Dim Pvt1 As PivotTable
Dim Pvt2 As PivotTable
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim pi1 As PivotItem
Dim pi2 As PivotItem
Dim cell As Range


Set Pvt1 = ActiveWorkbook.Worksheets("Total Bloodhound").PivotTables("PivotTable3")
Set Pvt2 = ActiveWorkbook.Worksheets("Total Closed").PivotTables("PivotTable1")
Set pf1 = Pvt1.PivotFields("time")
Set pf2 = Pvt2.PivotFields("time")
Dim index As Integer
index = 1

For Each pi1 In pf1.PivotItems
For Each pi2 In pf2.PivotItems
    If IsEmpty(pi2.Value) Then Exit For
        If pi1.Value = pi2.Value Then
            Worksheets("Sheet1").Cells(index, "A") = pi1.Value
            index = index + 1
    End If
Next pi2
Next pi1

End Sub

This code compares and copies all the dates with a month even though those dates are not in the pivot table. Any help would be great thanks!

Upvotes: 0

Views: 65

Answers (1)

EEM
EEM

Reputation: 6659

This code compares only visible PivotItems using the DataRange property of the PivotItem to determine if present in the PivotTable

Sub Ptb_CompareAndList()
Const kPFld As String = "time"
Dim Wsh As Worksheet
Dim Pt1 As PivotTable, Pt2 As PivotTable
Dim Pi1 As PivotItem, Pi2 As PivotItem
Dim rDtaRng As Range, lRow As Long

    Rem Set Objects
    With ThisWorkbook
        Set Wsh = .Sheets("Sheet1")
        Set Pt1 = .Sheets("Total Bloodhound").PivotTables("PivotTable3")
        Set Pt2 = .Sheets("Total Closed").PivotTables("PivotTable1")
    End With

    Rem Clear Prior Results
    Wsh.Columns(1).ClearContents

    For Each Pi1 In Pt1.PivotFields(kPFld).PivotItems

        Rem Validate PivotItem
        Set rDtaRng = Nothing
        On Error Resume Next
        Rem Use PivotItem DataRange property to determine if present in the PivotTable
        Set rDtaRng = Pi1.DataRange
        On Error GoTo 0
        If Not rDtaRng Is Nothing Then

            Rem Set PivotItem in PivotTable 2 directly to avoid For...Next
            Set Pi2 = Nothing
            On Error Resume Next
            Set Pi2 = Pt2.PivotFields(kPFld).PivotItems(Pi1.SourceNameStandard)
            On Error GoTo 0
            If Not Pi2 Is Nothing Then
                    Rem List Results
                    lRow = 1 + lRow
                    Wsh.Cells(lRow, 1) = Pi1.Value

    End If: End If: Next

End Sub

Upvotes: 0

Related Questions