pivot table by macro

  • Thread starter Thread starter Soe
  • Start date Start date
S

Soe

any chance to prepare pivot table by a macro.
if there is a way, Pls help me how to do it.
thanks.
 
Soe, record a macro when you make the pivot table, then next time you need
it just run the macro

--
Paul B
Always backup your data before trying something new
Using Excel 2000 & 97
Please post any response to the newsgroups so others can benefit from it
** remove news from my email address to reply by email **
 
Soe,

You may just record the creation of a pivottable.
However the code will not be very structured :(

But you could also look at following:


It creates 2 pivots side-by side. (a Top5 and a Bottom5)
not very usefull with the sample data :(


It uses the same pivotcache for both pivots => if 1 gets refreshed the
second it automatically updated too.
If uses a defined name with formula to allow for a variable data range.

You may have to edit the sheetnames sheetnames, but the principle for this
little thing is to base the pivot on a Defined Name (thus it's source
range is flexible and avoind the use of "hardcoded" names.

Example requires two sheets: "DATA" and "PIVOTS"
Data should start on A1 and No empties on the first row
or in first column

Example Data
lineNr lineName acctNr acctname period amount
110 Cash 1110 Cash 4 12000
110 Cash 1120 Bank 4 11000
120 Receivables 1210 Receivables 4 10000
120 Receivables 1220 Recbles Res 4 9000
130 Prepaid exp 1310 Prepaids 4 8000
140 Investments 1410 Investm 100% 4 7000
140 Investments 1420 Investm<100% 4 6000
150 Intercompany 1510 Interco A 4 5000
150 Intercompany 1520 Interco B 4 4000


It Requires Excel2000 or newer.


Option Explicit

Sub CreatePivots()
Dim heads As Variant
Dim pt As PivotTable
Dim pf As PivotField
Dim i

With ActiveWorkbook
On Error Resume Next
.Names("dnPivSource").Delete
With Worksheets("Pivots")
.PivotTables("Pivot1").TableRange2.Clear
.PivotTables("Pivot2").TableRange2.Clear
End With
On Error GoTo 0
.Names.Add "dnPivSource", _
"=OFFSET(Data!$A$1,0,0,COUNTA(Data!$A:$A),COUNTA(Data!$1:$1))"
End With

heads = [dnPivSource].Resize(1)

For i = 1 To 2
If i = 1 Then
Set pt = ActiveWorkbook.PivotCaches.Add(xlDatabase, _
"dnPivSource") .CreatePivotTable([Pivots!A1], "Pivot1")
ElseIf i = 2 Then
Set pt = ActiveWorkbook.PivotCaches(1) .CreatePivotTable( _
[Pivots!A1].Offset(, pt.TableRange2.Columns.Count + 1), _
"Pivot2")
End If

With pt
For Each pf In .VisibleFields
pf.Orientation = xlHidden
Next
.AddFields RowFields:=Array(heads(1, 3), heads(1, 4)), _
ColumnFields:=Array(heads(1, 5)), PageFields:=Array(heads(1, 2))
.PivotFields(heads(1, 6)).Orientation = xlDataField
.DataFields(1).Function = xlSum
If .Name = "Pivot1" Then
.DataFields(1).Name = "Top5"
.RowFields(1).AutoSort xlDescending, .DataFields(1).Name
.RowFields(1).AutoShow xlAutomatic, xlTop, 5, _
.DataFields(1).Name
.RowFields(1).Subtotals(1) = False
ElseIf .Name = "Pivot2" Then
.DataFields(1).Name = "Bot5"
.RowFields(1).AutoSort xlAscending, .DataFields(1).Name
.RowFields(1).AutoShow xlAutomatic, xlBottom, 5, _
.DataFields(1).Name
.RowFields(1).Subtotals(1) = False
End If
End With
Next
End Sub

keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
Back
Top