Pivot Tables in VBA

[Pelham]

Dear All

I have the following VBA script which cleans up columns of data that I
obtain using a series of Web Queries, and then creates a Pivot Table
for that worksheet. It works fine except for two (2) problems:

1. it grabs as much of the worksheet as possible (hence the
"R1C1:R65000C11") instead of finding only the cells containing data,
which is what a Pivot Table automatically does when you create one; and
2. I have to do each worksheet at a time instead of it automatically
moving to the next worksheet when I have many worksheets.

How can I modify it so that it only grabs cells with data and moves to
the next worksheet when it has completed the active worksheet?

(Please ignore the strange characters in the script because these are
Japanese characters and cannot show up in here...)

Thanks!

Regards
Pelham


Sub Pivot()
'
' Pivot Macro
' Macro recorded 14/11/2006
'
' Keyboard Shortcut: Ctrl+Shift+P
'
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
Selection.Font.Bold = True
Columns("A:A").EntireColumn.AutoFit
Selection.AutoFilter
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.NumberFormat = "#,##0"
Selection.copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("H:H").Select
Selection.NumberFormat = "0.00"
Rows("1:1").Select
Selection.Font.Bold = True
Range("C7").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=
_
"R1C1:R65000C11").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddFields
RowFields:=Array("Ward", _
"Data"), ColumnFields:="Type", PageFields:="City"
With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Rent(‰~)")
.Orientation = xlDataField
.Caption = "Average of Rent(‰~)"
.Position = 1
.Function = xlAverage
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Area")
.Orientation = xlDataField
.Caption = "Average of Area"
.Position = 2
.Function = xlAverage
End With
With
ActiveSheet.PivotTables("PivotTable1").PivotFields("‰~Â^•½•Ä")
.Orientation = xlDataField
.Caption = "Average of ‰~Â^•½•Ä"
.Function = xlAverage
End With
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
Cells.Select
Selection.NumberFormat = "#,##0"
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit
Range("D12").Select
Columns("A:A").ColumnWidth = 8.86
End Sub

 

[wisccal]

As for your first problem, you want to use a function like the
following:
http://www.mindspring.com/~tflynn/excelvba4.html#URange

It looks for the first and last row and first and last column that
contain data, respectively, and fills this range into theRng.

Regarding your second problem, you can just loop through the
ThisWorkbook.Sheets collection like so:

Dim wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = ThisWorkbook

For Each ws in Workbook.Sheets
ws.Activate
Call Pivot()
Next ws

Set wb = Nothing
Set ws = Nothing

Regards,
Steve

 

[Pelham]

Steve

Many thanks, but I am hitting an error when the VBA reaches the part
that you kindly helped me on. It stops at "For Each ws In
Workbook.Sheets".

The script now looks like this:

Sub Pivot()
'
' Pivot Macro
' Macro recorded 16/11/2006 by CBRE
'
' Keyboard Shortcut: Ctrl+Shift+P
'
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select
Selection.Font.Bold = True
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.NumberFormat = "#,##0"
Columns("I:I").Select
Selection.NumberFormat = "#,##0"
ActiveWindow.ScrollColumn = 2
Columns("H:H").Select
Selection.NumberFormat = "0.00"
ActiveWindow.ScrollColumn = 1
Range("A2").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=
_
"R1C1:R31927C11").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,
1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddFields
RowFields:=Array("Ward", _
"Data"), ColumnFields:="Type", PageFields:="City"
With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Rent(‰~)")
.Orientation = xlDataField
.Caption = "Average of Rent(‰~)"
.Position = 1
.Function = xlAverage
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Area")
.Orientation = xlDataField
.Caption = "Average of Area"
.Position = 2
.Function = xlAverage
End With
With
ActiveSheet.PivotTables("PivotTable1").PivotFields("‰~Â^•½•Ä")
.Orientation = xlDataField
.Caption = "Average of ‰~Â^•½•Ä"
.Position = 3
.Function = xlAverage
End With
With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Rent(‰~)")
.Orientation = xlDataField
.Caption = "Count"
.Function = xlCountNums
End With
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
Cells.Select
Selection.NumberFormat = "#,##0"
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.Select
Cells.EntireColumn.AutoFit
Selection.ColumnWidth = 9.86
Range("B6:B7").Select
Range("B7").Activate
Columns("B:B").EntireColumn.AutoFit
Range("A5").Select
ActiveWindow.FreezePanes = True
Rows("1:4").Select
Selection.Font.Bold = True
Columns("A:A").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With ActiveSheet
If .Index = Worksheets.Count Then
Worksheets(1).Activate
Else
.Next.Activate
End If
End With

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set wb = ThisWorkbook
For Each ws In Workbook.Sheets
ws.Activate
Call Pivot
Next ws
Set wb = Nothing
Set ws = Nothing
End Sub

Any ideas!?!??!

 

[Martin Los]

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Sheets
ws.Activate
Call Pivot
Next ws

should do the trick. So you should change "Workbook.Sheets" to
"wb.Sheets".

Let me know how this works.

Martin

Pelham ha escrito:

 

[wisccal]

Sorry about this mistake. Thanks for pointing that out, Martin

Steve