Need help to correct code

[Spooky7]

Hi part of my code is not working and need your assistance. I am getting an error message on PI.Visible = True.


Sub CopyPivData()
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
For Each PI In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Set NewWs = Worksheets.Add
NewWs.Name = PI

Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").Select
ActiveSheet.Paste
Next PI
End With
End Sub

[p45cal]

This is a guess. A file from you would be useful. Saves us guessing wrong.
Sub CopyPivData()
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In .PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Set NewWs = Worksheets.Add
NewWs.Name = PI
Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").Select
ActiveSheet.Paste
Next PI
End With
End Sub
There are 2 things I've done here:
1. You have Set PT = Worksheets(MyWs).PivotTables(MyPIV) but you never use it, now it's used.
2. Added 2 lines: to remove old items and to refresh the table.
You might be lucky and it'll work, otherwise it could be more complex (have you other filters on other fields which could be interfering?) and we'd need a file.

[Spooky7]

Thank you so much. Appreciate your help and prompt response How do I make a donation to you?

I also want to add on an extra code to copy and paste the worksheets as a Table so its neat and tidy but getting an error when I add the below code. Can you please advise.


Sub Test()
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Visible = True Then
Sh.Activate
Sh.Cells.Copy
Sh.Range("A1").PasteSpecial Paste:=xlValues
Sh.Range("A1").Select
End If
Next Sh
Application.CutCopyMode = False
End Sub

[SamT]

P45Cal,
I'm confused.


For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In .PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Next PI
Doesn't that set every PI2, other than the current PI, to visible = False, leaving only the last PI visible?

Please note, here is everything I know about Pivot Tables: "."

[SamT]

Spooky,

Sub Test()
Dim Sh As Worksheet

Application.ScreenUpdating = False
On Error GoTo GracefulExit

For Each Sh In ThisWorkbook.Worksheets
If Sh.Visible = xlSheetVisible Then
With Sh
.Cells.Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
End With
End If
Application.CutCopyMode = False
Next Sh

GracefulExit:
Application.ScreenUpdating =True
End Sub

[Spooky7]

Thank you! When I add your code to my existing code I get a Compile error: For control variable already in use? Please let me know what is wrong? Thanks for your help!


Sub CopyPivData()
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In .PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Set NewWs = Worksheets.Add
NewWs.Name = PI
Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").Select
ActiveSheet.Paste


Sub Test()
Dim Sh As Worksheet

Application.ScreenUpdating = False
On Error GoTo GracefulExit

For Each Sh In ThisWorkbook.Worksheets
If Sh.Visible = xlSheetVisible Then
With Sh
.Cells.Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
End With
End If
Application.CutCopyMode = False
Next Sh

GracefulExit:
Application.ScreenUpdating =True

Next PI
End With
End Sub

[SamT]

This is the last time I will format the code in your posts.
You can select the code, then click the # icon on the Editor menu, or
You can click the icon, then paste the code bwteen the [ Code} and {/ Code] tags, or
You can manually type the code tags before and after your code.

Note. don't leave any spaces in the code tags. I had to above so they would not be actually seen as tags.

[Spooky7]

Thank you very much for your help.

[SamT]

Now that I have formatted your code, take a look at your last post and see if you can tell what's wrong.

Before I offer any more code, I have a question. Do you only want the new Worksheets (Named for the PivotItem) to be formatted as tables per your post # 3?

[Spooky7]

Yes only the new worksheets to be formatted as Tables.

[SamT]

Option Explicit

Sub CopyPivData()
'Copies the data Values for each PivotItem to a new Sheet Named per the PI Name
'For help go to "http://www.vbaexpress.com/forum/showthread.php?53467-Need-help-to-correct-code#post329495"

Dim PT As PivotTable
Dim PI As PivotItem

MyWs = "Summary PIVOT"
MyPIV = "PivotTable1"
MyField = "Process Owner"
Set PT = Worksheets(MyWs).PivotTables(MyPIV)

Application.ScreenUpdating = False
On Error GoTo GracefulExit 'Prevents exiting while ScreenUpdating is False

With PT
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh

'Hide all Items
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = False
Next PI

For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
Set NewWs = Worksheets.Add
NewWs.Name = PI.Name '<<<<<<<< added PI Name Property
Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").PasteSpecial xlPasteValues 'Eliminate Sub "Test"
PI.Visible = False
Next PI

'Show all Items
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
Next PI
End With

GracefulExit:
Application.ScreenUpdating = True
End Sub

[p45cal]

P45Cal,
I'm confused.


For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
For Each PI2 In .PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Next PI
Doesn't that set every PI2, other than the current PI, to visible = False, leaving only the last PI visible?

Please note, here is everything I know about Pivot Tables: "."Yes, I think so, ultimately. But other things are happening inside the outer loop that I think the op wanted.

[p45cal]

Thank you so much. Appreciate your help and prompt response How do I make a donation to you?You could do it via a paypal email address (Private Message me here for it), but it really isn't necessary; the only acknowledgement I'm looking for is what you've already done, that is, replied. Even a Marked as Solved would have done.
What I despise, and it's happening more, is that someone gets help here and there's no evidence that they've even read the response, let alone used it. When it's evident that considerable effort has been made to give that person (free) help [I believe] it is absolutely incumbent on them to acknowledge it. Perhaps beause the help here is free, some people value it at zero.

[Spooky7]

Thank you SamT and P45cal your help is greatly appreciated.

[Spooky7]

I sent a private message.

[p45cal]

Yes only the new worksheets to be formatted as Tables.Do I take it that your copy range (A3:O724) in msg#1 includes the entirety of the pivot table and you're ending up with a pivot table on each new sheet, which you don't really want?

[SamT]

I got to thinking that you might have a lot of PivotItems and the loop might take some time. I added a note to the Excel StatusBar . I also corrected a couple of small errors in the code above. This code will Compile, but it is not otherwise tested.

Option Explicit

Sub CopyPivData()
'Copies the data Values for each PivotItem to a new Sheet Named per the PI Name
'For help go to "http://www.vbaexpress.com/forum/showthread.php?53467-Need-help-to-correct-code#post329495"

Dim PT As PivotTable
Dim PI As PivotItem
Dim NewWs As Worksheet
Dim StatusBarVisiblity As Boolean
Dim PICount As Long 'Used in Staus Bar Updating
Dim PINum As Long 'Used in Staus Bar Updating
Dim StatusBarUpdateFrequency As Long

Const MyWs = "Summary PIVOT"
Const MyPIV = "PivotTable1"
Const MyField = "Process Owner"

Set PT = Worksheets(MyWs).PivotTables(MyPIV)


With Application
.ScreenUpdating = False
StatusBarVisiblity = .DisplayStatusBar
.StatusBar = "Please be patient... Just starting to work"
End With

On Error GoTo GracefulExit 'Prevents exiting while ScreenUpdating is False

With PT
.PivotCache.MissingItemsLimit = xlMissingItemsNone
.PivotCache.Refresh
PICount = .PivotFields(MyField).PivotItems.Count
StatusBarUpdateFrequency = PICount \ 10 'Updates @ 10% increments

'Hide all Items
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = False
Next PI

For Each PI In .PivotFields(MyField).PivotItems
PINum = PINum + 1
PI.Visible = True
Set NewWs = Worksheets.Add
NewWs.Name = PI.Name '<<<<<<<< added PI Name Property
Worksheets(MyWs).Range("A3:O724").Copy
NewWs.Range("A1").PasteSpecial xlPasteValues 'Eliminate Sub "Test"
PI.Visible = False
If PINum Mod StatusBarUpdateFrequency < 1 Then _
Application.StatusBar = "Please be patient... " & _
Format((PINum / PICount) * 100, "00") & "% complete"
Next PI

'Show all Items
For Each PI In .PivotFields(MyField).PivotItems
PI.Visible = True
Next PI
End With

GracefulExit:
With Application
.ScreenUpdating = True
.StatusBar = False
.DisplayStatusBar = StatusBarVisiblity
End With
End Sub

[Spooky7]

yes the copy range is A3 to O724 I just sent you a shorter version of the table.

[SamT]

Thank you SamT and P45cal your help is greatly appreciated.

Thank you.
Does the code do what you want?

ps: I'm off to do some chores. I'll check back later.

[Spooky7]

I will try the new version and see if it works the previous one didn't.