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