Update Main Table with the help of table generated from Pivot Table in Excel

[sanits591]

Hi

I have been searching for a solution for the last few days, but unable to get anything relevant to it.

Data Available ( example)

1. One sheet with Name (Main Data) having the Data (with col A having Unique Values) with Validation in two columns (col D & Col E).
2. A pivot table is generated from this main table, and the values are simply the count and Sum in the "Values" section of the pivot table.
As soon as i double click on the field (on the values) a Data table, say "Generated Sheet" is generated consisting of values, now:

What i am looking for:

a) The column which are having data validation in the "Main Data" sheet should also have the data validation in the same columns (col D & col E) in the "Generated sheet", for the ease of operation or for amending the data.

b) If the data is edited in the "Generated Sheet" then it automatically changes the data in the "Main Data" sheet.
I would like to have this, because, merely editing a small portion on the "Generated sheet" shall be able to update the "Main Data".

I am not interested to touch "Main Data" directly for editing, as "Pivot Table" which is generated having so many filters, and requires to be changed for various analysis and can be drilled down to know the status of "generated sheet", and thereby the modification can be done there itself in "Generated Sheet" and which shall reflect in the "Main Data" sheet also.

I am not clear, moreover, i do not know how to take-off from here for the actions which i am seeking for.

Any assistance shall be appreciated for performing this task.

Thanks!

 

[sanits591]

Thankyou, i shall send you the same.

Have a nice sleep.

See you tomorrow!

 

[Jerry Sullivan]

Hi again,

I looked at the file you sent and found something interesting. After double-clicking the PivotTable, the drill-down data is written to a new sheet in a standard Worksheet Range - not a Table (ListObject).

I believe this is how drill-down behaved prior to xl2007. In doing some websearch to find out how to make a Pivot drill-down use a Range instead of a Table, I found a few threads where people asked that question and some experts responded that they didn't think that could be done with xl2007 and later.

After refreshing the Pivot in xl2010, it started making drill-down's in Tables. I tried different ways to get a new Pivot to make drill-down's in a Range and haven't found a consistent method. I managed to do this once, by some sequence of events that included checking the PivotTable Option "Classic PivotTable layout"...but then I wasn't able to repeat it. I'm interested to learn if you know how to do this, or have any thoughts on why this PivotTable behaves differently than the xl2010 default. (was it orginally copied from a xl2003 source?)

Regardless of how that is done, it's best this code work for drill-downs that are either a Table or Range.

I've modified the code to do that. On your sample workbook, it correctly copies the DV from the datasource to the drill-down.

Modified for ThisWorkbook Module...

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim rDetail As Range
    On Error Resume Next
    If sSourceDataR1C1 = vbNullString Then Exit Sub
    Set rDetail = Cells(1).CurrentRegion
    If rDetail Is Nothing Or rDetail.Rows.Count < 2 Then Exit Sub
    Call Format_PT_Detail(rDetail)
    
    Set rDetail = Nothing
End Sub

Modified for Standard Code Module...

Option Explicit

Public sSourceDataR1C1 As String

Public Function Format_PT_Detail(rDetail As Range)
[COLOR="#008080"]'---Called by Workbook_NewSheet; Passes Range of ShowDetail (typically a Table)
'---Uses Pivot Table's SourceData Property stored in Public sSourceDataR1C1
'--- to read apply Formats in first row of SourceData to rDetail[/COLOR]

    Dim sSourceDataA1 As String
    
    If sSourceDataR1C1 = vbNullString Then Exit Function
    sSourceDataA1 = Application.ConvertFormula(sSourceDataR1C1, _
            xlR1C1, xlA1)
    Range(sSourceDataA1).Resize(1).Offset(1).Copy
    With rDetail
        If .Rows.Count > 1 Then
            With .Offset(1).Resize(.Rows.Count - 1)
                .PasteSpecial Paste:=xlPasteValidation
                .PasteSpecial Paste:=xlPasteFormats  'optional
            End With
        End If
    End With
    sSourceDataR1C1 = vbNullString
End Function

The code that goes in the Sheet Module for the Sheet with the PivotTable is unchanged. It's reposted here for clarity.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
    Cancel As Boolean)
[COLOR="#008080"]'---If user double-clicks in PivotTable data, assigns a string reference to
'---  the Pivot Table's SourceData Property to Public string sSourceDataR1C1[/COLOR]

    On Error GoTo ResetPublicString
    With Target.PivotCell
        If .PivotCellType = xlPivotCellValue And _
            .PivotTable.PivotCache.SourceType = xlDatabase Then
                sSourceDataR1C1 = .PivotTable.SourceData
        End If
    End With
    Exit Sub
ResetPublicString:
    sSourceDataR1C1 = vbNullString
End Sub

Please confirm that's working as expected for you. I'll begin looking at the linking part of your question.

 

[sanits591]

Thanks Jeery !, It is really working for me. I got this file from somewhere, and was working on it to know about the VBA codes for accomplishing it.

This time, i tried using the new file in xl2010 and with the Pivot Table generated having the same code, is working for me with the xl2010 default Pivot table.

Now with this, we can proceed further for the next, i.e. linking to the main table.

Thanks!

 

[Jerry Sullivan]

I've made a first pass at some code to copy changes made in the DrillDown sheets to the Source Data.

It seems to work okay under some strict limitations, but this is still very experimental and should not be relied upon for any important purpose.

There are some remarks at the beginning of the code that describe some of the required setup and use.
Column A of your Source Data already had sequential counting numbers. I've added that setup as a requirement for this current version of the code, since it is much simpler than having other methods of lookup.

One of the most problematic aspects of this problem is keeping the Source Data, Pivot Cache and Drill Downs all synched. So far, I can't think of a good way to ensure that other than to only allow one DrillDown at a time and to refresh the PivotTable before the any DrillDown is generated. This code does not apply those restrictions, but that is one reason it should not be relied upon in its current form.

Parts of the code need to be copied to four specific locations. Delete previous versions of the code first.

Paste into a Standard Code Module...

Option Explicit

'---Link DrillDown

'   This code is an experimental development stage and should not be used for any important purpose.
'   Only use this code on a copy of your workbook

'   The purpose of this code is to copy changes made to PivotTable DrillDown data to the
'      Source Data of the PivotTable

'   Setup:
'   The Leftmost Column of the Source Data Range must contain counting numbers beginning with 1, 2, 3...
'   These values are used as a Row index to synch changes made in the DrillDown ranges.

'   Notes/Limitations:
'   1. The DrillDown sheet is protected to only allow edits to the data
'        (no changes to headers, formatting, adding/deleting/reordering rows or columns).
'   2. Having the same record in more than one DrillDown sheet, might result in DrillDown
'        records that are out of synch with Source Data.
'   3. The PivotTable should be refreshed before any DrillDowns are created. (add to code?)
'   4. Before changes are copied from the DrillDown to the SourceData, checks are made in an attempt
'        to ensure the fields match and all the other data in the record matches.
'        If a mismatch is detected, the values are not copied and the drill down cell is highlighted.
'   5. All DrillDown sheets must begin with the prefix "DD_". When created, these are numbered DD_01, DD_02,...
'        The DrillDown sheets may be renamed provided they retain the prefix.
'   6. Use the Macro: Delete_All_DrillDowns to delete all DrillDown sheets in the Workbook.


Public Const sDDPREFIX As String = "DD_" 'First characters for all DrillDown sheets
Public sSourceDataR1C1 As String


Dim clsEventLinkDrillDown As New CEventLinkDrillDown

Public Sub Enable_Link_to_SourceData()
    If IsDrillDown(ActiveSheet) Then _
        Set clsEventLinkDrillDown.EvtWorksheet = ActiveSheet
End Sub

Public Sub Disable_Link_to_SourceData()
    Set clsEventLinkDrillDown.EvtWorksheet = Nothing
End Sub

Private Function IsDrillDown(sh As Object) As Boolean
    IsDrillDown = Left(sh.Name, Len(sDDPREFIX)) = sDDPREFIX
End Function

Public Sub Rename_To_Next(ws As Worksheet)
    Const lMax_Count As Long = 99
      
    Dim i As Long
    For i = 1 To lMax_Count
        If Not SheetExists(sDDPREFIX & Format(i, "00")) Then
            ws.Name = sDDPREFIX & Format(i, "00")
            Exit Sub
        End If
    Next i
    MsgBox "Sheet not renamed. All allocated sheet names in use."
End Sub

Private Function SheetExists(sName As String) As Boolean
    On Error Resume Next
    SheetExists = Sheets(sName).Index > 0
End Function

Public Function Format_PT_Detail(rDetail As Range)
'---Called by Workbook_NewSheet; Passes Range of ShowDetail (typically a Table)
'---Uses Pivot Table's SourceData Property stored in Public sSourceDataR1C1
'--- to read apply Formats in first row of SourceData to tblNew
'---Places reference back to TopLeft of SourceData

    Dim sSourceDataA1 As String
    
    If sSourceDataR1C1 = vbNullString Then Exit Function

    On Error GoTo CleanUp
    sSourceDataA1 = Application.ConvertFormula(sSourceDataR1C1, _
            xlR1C1, xlA1)
    Range(sSourceDataA1).Resize(1).Offset(1).Copy
    With rDetail
        Application.EnableEvents = False
        '---make reference back to TopLeft Cell of SourceData
        rDetail(1, .Columns.Count + 2).Formula = "=" & Range(sSourceDataA1)(1).Address(External:=True)
        
        With .Offset(1).Resize(.Rows.Count - 1)
            .PasteSpecial Paste:=xlPasteValidation
            .PasteSpecial Paste:=xlPasteFormats         'optional
            .PasteSpecial Paste:=xlPasteColumnWidths    'optional
        End With

        '---unlock only cells to be edited.
        If .Columns.Count > 1 Then .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Locked = False
        .Parent.Protect UserInterfaceOnly:=True
    End With
CleanUp:
    Application.EnableEvents = True
    sSourceDataR1C1 = vbNullString
End Function

Public Sub Delete_All_DrillDowns()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    
    For Each ws In ActiveWorkbook.Worksheets
        If IsDrillDown(ws) Then ws.Delete
    Next ws
    Application.DisplayAlerts = False
End Sub

Paste into ThisWorkbook Module...

Private Sub Workbook_NewSheet(ByVal sh As Object)
    Dim rDetail As Range
    On Error Resume Next
    If sSourceDataR1C1 = vbNullString Then Exit Sub
    Set rDetail = Cells(1).CurrentRegion

    If rDetail Is Nothing Then Exit Sub
    If rDetail.Rows.Count < 2 Then
        MsgBox "No drill down data. This sheet will not be linked to Source Data."
    Else
        Call Rename_To_Next(ActiveSheet)
        Call Format_PT_Detail(rDetail)
    End If
    
    Set rDetail = Nothing
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Enable_Link_to_SourceData
End Sub

Private Sub Workbook_SheetDeactivate(ByVal sh As Object)
    Disable_Link_to_SourceData
End Sub

Paste to the Sheet Code Module of the Sheet with the PivotTable...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
    Cancel As Boolean)
'---If user double-clicks in PivotTable data, assigns a string reference to
'---  the Pivot Table's SourceData Property to Public string sSourceDataR1C1

    On Error GoTo ResetPublicString
    With Target.PivotCell
        If .PivotCellType = xlPivotCellValue And _
            .PivotTable.PivotCache.SourceType = xlDatabase Then
                sSourceDataR1C1 = .PivotTable.SourceData
        End If
    End With
    Exit Sub
ResetPublicString:
    sSourceDataR1C1 = vbNullString
End Sub

This last part needs to be copied into a Class Module named: CEventLinkDrillDown

Option Explicit

Public WithEvents EvtWorksheet As Worksheet

Private Sub EvtWorksheet_Change(ByVal Target As Range)
    Dim sSourceRef As String
    Dim vRecord1 As Variant, vRecord2 As Variant
    Dim lIdx_Row As Long, lIdx_Col As Long, i As Long
    Dim c As Range, rSourceA1 As Range, rDetail As Range
        
    With Target.Parent
        If Target.Columns.Count > 1 Then
            MsgBox "You may only edit one column at a time to ensure synch with Source Data."
            Target.Interior.Color = vbRed
            GoTo CleanUp
        End If
        sSourceRef = .Cells(1, .Columns.Count).End(xlToLeft).Formula
        On Error Resume Next
        Set rSourceA1 = Range(sSourceRef)
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Set rDetail = .Cells(1).CurrentRegion
        
        On Error GoTo CleanUp:
        If Not rSourceA1 Is Nothing Then
            For Each c In Target
                lIdx_Row = .Cells(c.Row, "A")
                lIdx_Col = c.Column
                '--check field matches
                If .Cells(1, lIdx_Col) <> rSourceA1(1, lIdx_Col) Then
                    MsgBox "Mismatch with Source data field. Changes not copied."
                    c.Interior.Color = vbRed
                End If
                '--check record matches
                vRecord1 = Application.Transpose(Application.Transpose( _
                    rDetail.Resize(1).Offset(c.Row - 1)))
                vRecord2 = Application.Transpose(Application.Transpose( _
                    rSourceA1.Resize(1, rDetail.Columns.Count).Offset(lIdx_Row)))
                vRecord2(lIdx_Col) = c.Value2 'adjust for changed cell

                If Join(vRecord1, "|") <> Join(vRecord2, "|") Then
                    MsgBox "Mismatch with Source data record. Changes not copied."
                    c.Interior.Color = vbRed
                End If
                c.Copy ' +1 for header
                rSourceA1(lIdx_Row + 1, lIdx_Col).PasteSpecial (xlPasteFormulasAndNumberFormats)
            Next c
        Else
            MsgBox "Invalid reference to source data. Changes not copied."
            Target.Interior.Color = vbRed
        End If
    End With
CleanUp:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

I'll be interested to hear your thoughts after you've done some testing.

 

[sanits591]

I apologize for the delayed response, as I was unable to check on xl2010. After testing it with the requirement, it worked perfectly what has been thought of.

It is really appreciated for the pain taken to resolve this issue.

Thankyou very much Jerry!