Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Pivot Tables in VBA
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 13
Default Pivot Tables in VBA
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:=xlDatab ase, 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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 51
Default Pivot Tables in VBA
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 wrote:

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:=xlDatab ase, 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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 13
Default Pivot Tables in VBA
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:=xlDatab ase, 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!?!??!

wrote:
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 wrote:

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:=xlDatab ase, 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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 4
Default Pivot Tables in VBA
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:

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:=xlDatab ase, 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!?!??!

wrote:
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 wrote:

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:=xlDatab ase, 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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 51
Default Pivot Tables in VBA
Sorry about this mistake. Thanks for pointing that out, Martin

Steve

Martin Los schrieb:

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:

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:=xlDatab ase, 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!?!??!

wrote:
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 wrote:

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:=xlDatab ase, 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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Pivot tables - Editing the data source shared by multiple pivot ta sankat Excel Discussion (Misc queries) 1 April 22nd 10 03:05 PM
Building pivot tables in Excel 2007 based on existing pivot tables? [email protected] Excel Discussion (Misc queries) 4 December 26th 07 08:05 PM
Pivot Table Data Adding contents of two pivot tables and param que Roundy Excel Discussion (Misc queries) 0 July 2nd 07 10:20 PM
How does the term 'pivot' apply to Excel's Pivot tables and Pivot. stvermont Excel Discussion (Misc queries) 1 February 17th 05 01:34 AM
Pivot tables-controlling user interaction with pivot tables Sindhura Excel Programming 0 August 27th 03 02:10 PM


All times are GMT +1. The time now is 01:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright 2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement