dynamic pivot table with chart

avik thakur

New Member
Joined
Mar 29, 2016
Messages
1
i am working with a large amount of data which have to be filtered and then displayed as a pivot table and individual 2D graphs.
the problem i am facing is with the pivot table because each time i loop i am creating the pivot table with the same name which throws error.Also i am unable to filter the value of the pivot table column SERVER.i tried a lot with making this code dynamic but these two issues i am totally unable to resolve.Please help me out on this.


Sub Macro5()
'
' Macro5 Macro
'

'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "SERVER"
Range("B1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("C1").Select
ActiveCell.FormulaR1C1 = "CATEGORY"
Range("D1").Select
ActiveCell.FormulaR1C1 = "TIME ELAPSED"
Range("E1").Select
ActiveCell.FormulaR1C1 = "UNIQUE SERVER NAMES"
'Give headings to all
Dim LastRow1 As Long
With ActiveSheet
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
'LastRow1 Variable to find the last row for applying filter in server name column to find unique server names
End With
Columns("A:A").Select
Range("A1:" & "A" & LastRow1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"E2"), Unique:=True
' Finding all unique server names from column A
Dim LastRow2 As Long
With ActiveSheet
LastRow2 = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
MsgBox ("Last row of unique server name column:" & (LastRow2))
' Finding last filled row in the unique server name column
' LastRow2 Variable to find the last row in unique server name column to fill values into array
Dim strArray() As String
Dim v As Long
ReDim strArray(3 To LastRow2)
For v = 3 To LastRow2
strArray(v) = Cells(v, 5).Value
Next
MsgBox "Loaded " & UBound(strArray) & " items from server name!"
' Storing values in an array strArray
MsgBox Join(strArray, ", ")
'Display the values of array

Dim Filter_criteria(1 To 2) As String
Dim vItm As Variant
Filter_criteria(1) = "CPU_Utilization"
Filter_criteria(2) = "Memory_Utilization"
'Insert Filter criteria


For Each vItm In Filter_criteria

Range("A1:E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$1").AutoFilter Field:=3, Criteria1:= _
vItm
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Sheets("Sheet1").Select
Sheets("Sheet1").Name = vItm
'Pasting values of each CPU/Memory in new workbooks
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
'Last Row variable to select data for pivot sheet

Dim SrcData As String
SrcData = ActiveSheet.Name & "!" & Range("$A$1:$E$1" & LastRow).Address(ReferenceStyle:=xlR1C1)
Dim pvtCache As PivotCache
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=SrcData)
'Create Pivot Cache from Source Data
Dim pvt As PivotTable
Set pvt = pvtCache.CreatePivotTable(TableDestination:="", _
TableName:="PivotTable102364")

With ActiveSheet.PivotTables("PivotTable102364")
.ColumnGrand = False
.RowGrand = False
End With
With ActiveSheet.PivotTables("PivotTable102364").PivotFields("SERVER")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable102364").PivotFields("SERVER")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable102364").PivotFields("TIME")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable102364").PivotFields("TIME")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable102364").AddDataField ActiveSheet. _
PivotTables("PivotTable102364").PivotFields("TIME ELAPSED"), _
"Sum of TIME ELAPSED", xlSum
With ActiveSheet.PivotTables("PivotTable102364").PivotFields("TIME")
.Orientation = xlRowField
.Position = 1
End With
'Make the pivot table
Dim LastColumn As Long
With ActiveSheet
LastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
'LastColumn variable to select the end column for formatting
Dim Mcl As String
Range("A4").Select
ActiveSheet.PivotTables("PivotTable102364").CompactLayoutRowHeader = "TIME "
If LastColumn > 26 Then
Mcl = Chr(Int((LastColumn - 1) / 26) + 64) & Chr(Int((LastColumn - 1) Mod 26) + 65)
Else
Mcl = Chr(LastColumn + 64)
End If
Range("A4:" & Mcl & "4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveWorkbook.ShowPivotTableFieldList = False

'Formatting the Pivot Table
Dim vItm1 As Variant
Dim r As Variant

For Each vItm1 In strArray
Sheets("Sheet4").Select
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets("Sheet4").Range("A4:D" & lastrowfinal)
'lastrowfinal variable to be created which counts the last filled row in column A
'issue with filtering the pivot table for each unique server


Next vItm1
'Making the graph

Dim wbkNew As Workbook
Dim wshNew As Worksheet
Set wbkNew = Workbooks.Open("BatchRun.xlsx")
Set wshNew = wbkNew.Worksheets("Sheet1")
Range("A1:D1").Select
Selection.AutoFilter
'insert command to return to BatchRun sheet and close the filter applied already

Next vItm
End Sub
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top