Solved: Pivot table trouble

[Scadadude]

Hi,
I have a pivot table as shown below which is pretty straight forward however I am trying to create a macro that will automatically change the point name to match the point name in column E then copy that resulting dispaly to another sheet then pick the next point name in line and do the same thing and repeat for 50 rows, so my end result will be 50 pivot tables ready for printing. I can do this manually but I am trying to make it automatic...BTW the point names in column E change everyday but the pivot table supports the name changes.



Thanks
Scadadude

[mdmackillop]

Hi Scadadude
Welcome to VBAX
Can you post a sample workbook?

[Scadadude]

Hope you can see this, I guess my .bmp file didnt work

Thanks again

[mdmackillop]

Yor BMP was OK, but can you post the Excel workbook?. It makes it easier to test a solution.

[Scadadude]

I am no longer at work where the workbook resides and it exceeds the size limit.

Scadadude

[mdmackillop]

You can send a zip file, or trim it to show some sample data/layout

[Scadadude]

Ok here is the .zip. file. The table is on Sheet18 in case it doesnt open up on that page. Hope this helps ya.

Thanks

Scadadude

[mdmackillop]

Try this
[VBA]
Option Explicit
Sub PointName()
Dim Ws As Worksheet
Dim Rng As Range, Cel As Range

Set Ws = ActiveSheet
Set Rng = Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))

For Each Cel In Rng
Ws.PivotTables("PivotTable1").PivotFields("Point Name").CurrentPage = Cel & " "

Ws.Columns("A:B").Copy
Sheets.Add
With ActiveSheet
.Paste
.Name = Trim(Cel)
.Range("A1").Select
End With
Next
Ws.Activate
End Sub

[/VBA]

[Scadadude]

Perfect! Absolutely Perfect. I owe you lunch!


Thanks so much
Scadadude

[mdmackillop]

Glad to help. You can mark your thread Solved using the Thread Tools dropdown.

[Scadadude]

I turned this off for a while and I am ready to use it again and now I am getting errors. Any help is apprecitated here is the code

Sub PointName()

Dim Ws As Worksheet
Dim Rng As Range, Cel As Range

Set Ws = ActiveSheet
Set Rng = Range(Cells(2, 7), Cells(Rows.Count, 7).End(xlUp))

For Each Cel In Rng
Ws.PivotTables("PivotTable1").PivotFields("Point Name").CurrentPage = Cel & " "

Ws.Columns("A:B").Copy
Sheets.Add
With ActiveSheet
.Paste
.Name = Trim(Cel)
.Range("A1").Select
End With
Next
Ws.Activate
End Sub


The error I am getting is Unable to set the _Default property of the PivotItem class

and the debugger is highlighting this part
Ws.PivotTables("PivotTable1").PivotFields("Point Name").CurrentPage = Cel & " "

Any ideas where to look?

Thanks

Scadadude