Consulting

Results 1 to 14 of 14

Thread: RE: copy paste entire pivot data Using VBA

  1. #1

    RE: copy paste entire pivot data Using VBA

    Hi all,

    Need your help on the topic -copy entire pivot data and paste as values using VBA. Tried out macro recording as well but it shows code of usual copy paste in VBA. Also attached the dummy data for your reference

    Help Required:

    I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M and again paste the same pivot below with opposite sign for values of Total column and ignore "Units" column in column L.

    Region Rep Item Units Sum of Total ->pivot headers


    Thanks for your help in advance.
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,039
    Sub blah()
    Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
    Set Tablerange = pt.TableRange1
    Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3)
    Destn1.Value = Tablerange.Value
    Set Destn2 = Destn1.Offset(Tablerange.Rows.Count + 3).Resize(, Tablerange.Columns.Count - 1)
    UnitsColm = Application.Match("Units", Destn1.Rows(1), 0)
    If UnitsColm = Destn1.Columns.Count Then
      Set SourceRng = Destn1.Resize(, Destn1.Columns.Count - 1)
    Else
      Set SourceRng = Union(Destn1.Resize(, UnitsColm - 1), Intersect(Destn1, Destn1.Offset(, UnitsColm)))
    End If
    SourceRng.Copy
    Destn2.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells
      If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = cll.Value * -1
    Next cll
    End Sub
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3

    RE: copy paste entire pivot data Using VBA

    Hi p45cal,

    Thanks for your help. The code looks fine but facing some issues in it. If you can add little more description it would be helpful.

    Also, please consider the below points to be included in the help:

    1) Grand totals should not be included during copy paste.
    2)
    I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M. Once this step is done - Based on last filled row, again paste the same pivot below with opposite sign for values of Total column(if the total values are negative then paste as positive) and ignore "Units" column in column L.

    Thanks for your help in advance.

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,325
    Location
    Another way

    Option Explicit
    
    
    Sub DoStuff()
        Dim pt As PivotTable
        Dim ptTable As Range, rNeg As Range, rNegRow As Range
        Dim i As Long
    
    
        Set pt = ActiveSheet.PivotTables(1)
        
        Set ptTable = pt.TableRange1
        
        With ptTable
            If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
            If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
        End With
            
        With ptTable
            .Cells(0, 1).Offset(1, .Columns.Count + 3).CurrentRegion.Clear
        
            .Copy
            .Cells(0, 1).Offset(1, .Columns.Count + 3).PasteSpecial Paste:=xlPasteValues
        
            Set rNeg = .Cells(0, 1).Offset(1, .Columns.Count + 3).CurrentRegion
            Set rNegRow = .Cells(0, 1).Offset(1, .Columns.Count + 3).End(xlDown).Offset(1, 0)
        End With
        
        Set rNeg = rNeg.Cells(2, 1).Resize(rNeg.Rows.Count - 1, rNeg.Columns.Count)
        rNeg.Copy rNegRow
        
        Set rNeg = rNeg.CurrentRegion
        
        On Error Resume Next
        For i = rNegRow.Row To rNeg.Cells(1, 1).End(xlDown).Row
            ActiveSheet.Cells(i, 13).Value = -1 * ActiveSheet.Cells(i, 13).Value
        Next i
        On Error GoTo 0
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,039
    More notes on a changed offering:
    Sub blah()
    Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
    'pt is an object variable being the pivot table object and all its properties.
    pt.ColumnGrand = False
    Set Tablerange = pt.TableRange1 'Create a range variable called Tablerange being the entire table cell range less the Page fields (=Filters) (which you don't have anyway).
    Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3) 'create a range variable for where the first copying will end up.
    'Offset uses Offset(no. of rows, no. of columns); the row section is left blank so there's no offset for rows, you could put a zero in instead)...
    '.Columns.Count+3 means the copied data will leave 3 blank columns beyond the original pivot table.
    'Destn1.Select 'enable this line so you can get a visual of where Destn1 is on the sheet when using keyboard F8 to step through the code line by line.
    Destn1.Value = Tablerange.Value 'copy the values over.
    pt.ColumnGrand = True
    Set Destn2 = Destn1.Offset(Tablerange.Rows.Count + 3).Resize(, Tablerange.Columns.Count - 1) 'creates the range variable 3 rows below Destn1 (there's no column component in the Offset), but resize it to have one column fewer.
    'UnitsColm = Application.Match("Sum of Units", Destn1.Rows(1), 0)
    UnitsColm = Application.Match("Units", Destn1.Rows(1), 0) 'This just determines which column is going to be missed out; it looks for 'Units' in the first row of the first copied range.
    'In case you don't have the same arrangement of columns as you have now:
    If UnitsColm = Destn1.Columns.Count Then 'if the Units column is the last column
      Set SourceRng = Destn1.Resize(, Destn1.Columns.Count - 1)
    Else 'if the Units column isn't the last column
      Set SourceRng = Union(Destn1.Resize(, UnitsColm - 1), Intersect(Destn1, Destn1.Offset(, UnitsColm)))
      'SourceRng.Select 'enable this line for a visual of what's going to be copied.
    End If
    SourceRng.Copy 'copy to clipboard
    Destn2.PasteSpecial Paste:=xlPasteValues 'paste values to Destn2.
    Application.CutCopyMode = False 'lose the dotted line around the copied range.
    For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells 'take each cell in the last column of the newly copied data (assumes that the Total column is the last column).
      If IsNumeric(cll.Value) And Len(cll.Value) > 0 And cll.Value < 0 Then cll.Value = cll.Value * -1 'if the value is numeric and not empty and less than 0 then multiply by -1 to flip from negative to positive.
    Next cll
    End Sub
    re Point 1: Lines have been added to remove the grand total before copying and to reinstate it after copying has completed.
    re Point 2: All that is already happening, except I've changed the line which flips values from negative to positive but now leaves positive numbers alone.

    I'm not sure what you mean by ignoring 'Units' column - I've assumed you want just to miss it out rather than aggregate similar values to leave fewer rows (eg. Central|Andrews|Penci has three rows which could be aggregated to one row).

    There may also be a Power Query solution.
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    Hi Paul,

    Thanks for your quick response and help! Going forward will share the code which i worked on macros to help in my requirement in the forum as suggested by you.

    The code works fine. However, the below highlighted one which i have i requested earlier is missing in your code.

    I have a pivot table in range from (A: E). I need to Copy and paste the entire pivot in column I to M. Once this step is done - Based on last filled row, again paste the same pivot below with opposite sign for values of Total column(if the total values are negative then paste as positive) and ignore "Units" column in column L.

    Please Help out.


    Thanks for your support in advance

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,039
    Paul, an interesting gotchya with your:
    With ptTable
      If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
      If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
    End With
    Add some select statements and step through it:
    With ptTable
      If pt.RowGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count, .Columns.Count - 1)
      ptTable.Select
      .Select
      If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, .Columns.Count)
      ptTable.Select
      .Select
    End With
    RowGrand is True in the supplied pivot, so after the first If, the ptTable becomes one column fewer.
    ColumnGrnd is also True, but because the subsequent Set statement uses the With version of ptTable (which doesn't change at all within the confines of the With…End With), the .Columns.Count is the width of the original pivot!
    To correct that we'd need to use the new ptTable instead of the With…End With version thus:

    If pt.ColumnGrand Then Set ptTable = .Cells(1, 1).Resize(.Rows.Count - 1, ptTable.Columns.Count)

    (RowGrand being true doesn't show an extra column on this pivot because of the orientation of the pivot (had all the items which are currently in the Rows section of the pivot been in the Columns section we'd have seen row grand totals).
    So in this instance we'd end up with a range to copy which is short of a column but as luck would have it the RowGrand line is effectively ignored in your original code! To get round this we should turn off grand totals, do the copying, then restore them:
    OriginalRowGrand = pt.RowGrand
    OriginalColumnGrand = pt.ColumnGrand
    pt.RowGrand = False
    pt.ColumnGrand = False
    
    'do the copying
    
    pt.RowGrand = OriginalRowGrand
    pt.ColumnGrand = OriginalColumnGrand
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    7,325
    Location
    Yea, missed that, but as you said I lucked out, and in this case, two wrongs did make a right
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    Sample1.jpg

    Hi p45cal,

    Thanks for your response. Also, thanks for updating your code with points which i have highlighted. Regarding your point, i have provided:

    I'm not sure what you mean by ignoring 'Units' column - I've assumed you want just to miss it out rather than aggregate similar values to leave fewer rows (eg. Central|Andrews|Penci has three rows which could be aggregated to one row). - I have stated to ignore Units column which means we have to copy and paste the pivot again below the first step (entire pivot data copy and paste)as values we have to ignore units column( leave it Empty/blank cells) and pasting total columns with opposite sign( All that is already happening, except I've changed the line which flips values from negative to positive but now leaves positive numbers alone - done by Paul code) .


    Attached the sample output which i have requested as help in form of image for your reference.

  10. #10
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,039
    Sub blah2()
    Set pt = Range("A3").PivotTable    'note that cell A3 is any cell within the pivot table.
    OriginalRowGrand = pt.RowGrand
    OriginalColumnGrand = pt.ColumnGrand
    pt.RowGrand = False
    pt.ColumnGrand = False
    Set Tablerange = pt.TableRange1
    Set Destn1 = Tablerange.Offset(, Tablerange.Columns.Count + 3)
    Destn1.Value = Tablerange.Value
    pt.RowGrand = OriginalRowGrand
    pt.ColumnGrand = OriginalColumnGrand
    Set SourceRng = Intersect(Destn1, Destn1.Offset(1))
    Set Destn2 = SourceRng.Offset(SourceRng.Rows.Count)
    UnitsColm = Application.Match("Units", Destn1.Rows(1), 0)
    SourceRng.Copy Destn2
    Destn2.Columns(UnitsColm).ClearContents
    For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells
      If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = Abs(cll.Value)
    Next cll
    End Sub
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  11. #11
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,918
    I'd use:

    Sub M_snb()
       With Sheet1.PivotTables(1).TableRange1
           .Copy Sheet1.Cells(3, 9)
           .Copy Sheet1.Cells(.Rows.Count + 6, 9)
       End With
       
       With Sheet1.PivotTables(1)
            .PivotFields("Units").Orientation = 0
            .PivotFields("Sum of Total").Orientation = 0
            .CalculatedFields.Add("inversion", "= -1*Total").Orientation = 4
      End With
    End Sub

  12. #12
    hi p45cal,

    Original 1.PNG

    The code works completely fine now in dummy data which i shared with you. Attached the image of original data pivot headers for your reference.


    When i applied the same code in original data facing error. I have also changed the range of pivot from A3 to A4 in the first line of your code. Also, renamed the units column with name "TP". still Facing error at the line highlighted below:


    UnitsColm = Application.Match("TP", Destn1.Rows(1), 0) 'This just determines which column is going to be missed out; it looks for 'Units' in the first row of the first copied range -> Replaced units with TP column name
    SourceRng.Copy Destn2 ' Need to understand this line what it does
    Destn2.Columns(UnitsColm).ClearContents -> Facing error here -> Run time error '13' Type mistmatch
    For Each cll In Destn2.Columns(Destn2.Columns.Count).Cells 'take each cell in the last column of the newly copied data (assumes that the Total column is the last column).
    If IsNumeric(cll.Value) And Len(cll.Value) > 0 Then cll.Value = Abs(cll.Value) 'if the value is numeric and not empty and less than 0 then multiply by -1 to flip from negative to positive.
    Next cll
    End Sub


    Kindly help out. Hope this would be the final help required from my end in this thread.


    Thanks for your support in advance.
    Attached Images Attached Images

  13. #13
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,039
    It's not finding TP because it's looking in the first row of copied data, but your new pivot contains an added header 'Sum of Items Value' above the columns headers, which implies there may be something in the columns field.
    You really ought to attach the real thing or a more accurate representation of the real thing as a workbook.
    A quick fix might be:
    UnitsColm = Application.Match("TP", Destn1.Rows(2), 0)
    but it would probably mess up elsewhere.

    SourceRng.Copy Destn2
    just copy/pastes SourceRng to Destn2
    Add the lines:
    SourceRng.select
    Destn2.Select
    before the copying line and step throuigh the code with F8 on the keyboard to see what those areas are.
    p45cal - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  14. #14
    Hi p45cal,

    As per your suggestion already i step through the code and understood it.
    Also changed the line which refers TP column: UnitsColm = Application.Match("TP", Destn1.Rows(2), 0)

    The code works absolutely fine which helped to fix my request. Thank you so much - p45cal for sharing your suggestions and code and sorry for annoying much by posting multiple requests from my end.


    Thanks a lot to each of you for your kind suggestions and help .


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •