S
smonczka
- Automaticly Refreshing Pivot Table Data
I have a made a macro called "depsub" that gathers sales data from each
one of our sales departments, compiles it onto one page, sorts it and
SUBTOTALs the data by employee and department. I also have a
PivotTable that needs to use this same data. PivotTables can not be
generated from subtotaled data. So I have to nest a macro within my
"depsub" macro that generates a PivotTable prior to the data being
subtotaled.
Problem is every time I try to do this the macro errors out and stops
when I try to creat the pivot table.
Here is a sample of the code...
Sub LineUp()
'
' LineUp Macro
' Macro recorded 10/27/2004 by Steven R. Monczka
'
' Keyboard Shortcut: Ctrl+Shift+L
'
' Turn off screen updating
Application.ScreenUpdating = False
'
' Remove Subtotal
Sheets("LineUp").Select
Range("A4").Select
Rows("4:4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete Shift:=xlUp
Range("A4").Select
'
' Get Data
Workbooks.Open Filename:= _
"Channel Data.xls" _
, UpdateLinks:=3, ReadOnly:=True
Sheets("LineUp").Select
Rows("4:50").Select
Selection.Copy
Windows("LineUp.xls").Activate
Rows("4:4").Select
ActiveSheet.Paste
Rows("51:51").Select
Windows("Channel Data.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
Workbooks.Open Filename:= _
"Corp Data.xls" _
, UpdateLinks:=3, ReadOnly:=True
Sheets("LineUp").Select
Rows("4:114").Select
Selection.Copy
Windows("LineUp.xls").Activate
ActiveSheet.Paste
Rows("162:162").Select
Windows("Corp Data.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
'
' Sort data
Rows("4:417").Select
Range("A417:A417").Activate
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending,
Key2:=Range("B4") _
, Order2:=xlAscending, Key3:=Range("C4"), Order3:=xlAscending,
Header:= _
xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal,
DataOption3:= _
xlSortNormal
Range("A4").Select
'
' Refresh Pivot Table
Range("A3").Select
Sheets("Heat").Select
Range("D6").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
Sheets("LineUp").Select
Range("A3").Select
'
' Subtotal
Range("A4").Select
Rows("3:8").Select
Selection.Insert Shift:=xlDown
Range("E27").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum,
TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(8), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=90
Rows("3:8").Select
Selection.Delete Shift:=xlUp
Range("A4").Select
'
' Turn on screen updating
Application.ScreenUpdating = True
If you guys can give me any help at all, thanks!
Steve Monczka
I have a made a macro called "depsub" that gathers sales data from each
one of our sales departments, compiles it onto one page, sorts it and
SUBTOTALs the data by employee and department. I also have a
PivotTable that needs to use this same data. PivotTables can not be
generated from subtotaled data. So I have to nest a macro within my
"depsub" macro that generates a PivotTable prior to the data being
subtotaled.
Problem is every time I try to do this the macro errors out and stops
when I try to creat the pivot table.
Here is a sample of the code...
Sub LineUp()
'
' LineUp Macro
' Macro recorded 10/27/2004 by Steven R. Monczka
'
' Keyboard Shortcut: Ctrl+Shift+L
'
' Turn off screen updating
Application.ScreenUpdating = False
'
' Remove Subtotal
Sheets("LineUp").Select
Range("A4").Select
Rows("4:4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete Shift:=xlUp
Range("A4").Select
'
' Get Data
Workbooks.Open Filename:= _
"Channel Data.xls" _
, UpdateLinks:=3, ReadOnly:=True
Sheets("LineUp").Select
Rows("4:50").Select
Selection.Copy
Windows("LineUp.xls").Activate
Rows("4:4").Select
ActiveSheet.Paste
Rows("51:51").Select
Windows("Channel Data.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
Workbooks.Open Filename:= _
"Corp Data.xls" _
, UpdateLinks:=3, ReadOnly:=True
Sheets("LineUp").Select
Rows("4:114").Select
Selection.Copy
Windows("LineUp.xls").Activate
ActiveSheet.Paste
Rows("162:162").Select
Windows("Corp Data.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
'
' Sort data
Rows("4:417").Select
Range("A417:A417").Activate
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending,
Key2:=Range("B4") _
, Order2:=xlAscending, Key3:=Range("C4"), Order3:=xlAscending,
Header:= _
xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal,
DataOption3:= _
xlSortNormal
Range("A4").Select
'
' Refresh Pivot Table
Range("A3").Select
Sheets("Heat").Select
Range("D6").Select
ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
Sheets("LineUp").Select
Range("A3").Select
'
' Subtotal
Range("A4").Select
Rows("3:8").Select
Selection.Insert Shift:=xlDown
Range("E27").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum,
TotalList:=Array(8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(8), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
ActiveWindow.SmallScroll Down:=90
Rows("3:8").Select
Selection.Delete Shift:=xlUp
Range("A4").Select
'
' Turn on screen updating
Application.ScreenUpdating = True
If you guys can give me any help at all, thanks!
Steve Monczka