Excel VBA Macro to get filtered Pivot Data from an .xlsb Input File in to our Target Template File
'This Macro will open the target Input File and then go to the target Pivot Table in a desired sheet and apply the desired Filters and extracts the data(Show details data/Get Pivot data from Grand Totals) and then copy and paste that extracted data in to our Report Template.
Sub GetFilteredPivotData()
Dim SourcePath As String
Dim SrcFileName As String
Dim SourceFile As String
Dim TargetFile As Workbook
Dim MyRange As Long
Dim TargetRange As Long
Dim CurQtr As String
Dim PVT_GrandTotal As Range
Dim X As Integer
Dim Y As Integer
Dim Response As Integer
Dim Response As Integer
SourcePath = "C:\Tamatam\Input\"
SourceFile = "Reddys_Detailed_Sales_Report.xlsb"
ThisWorkbook.Sheets("LastWeekSales").Activate
MyRange = ActiveSheet.UsedRange.Rows.Count
Range("$A$2:$BF$" & MyRange).Select
Selection.Clear
Set TargetFile = Workbooks.Open(SourcePath & SourceFile)
TargetFile.Activate
Worksheets("WeeklySales").Select
TargetFile.Activate
Worksheets("WeeklySales").Select
ActiveSheet.PivotTables("PivotTable5").PivotFields("Forecast_State").CurrentPage
= "Committed"
' The Following Code will Unfilter the Blanks in
PivotFilter:
' For x = 1 To
ActiveSheet.PivotTables("PivotTable5").PivotFields("XYZ").PivotItems.Count
' If InStr(1,
ActiveSheet.PivotTables("PivotTable5").PivotFields("XYZ").PivotItems(x).Value,
"") > 0 Then
' ActiveSheet.PivotTables("PivotTable5").PivotFields("XYZ").PivotItems(x).Visible
= False
' End If
' Next
QTR:
'Passing the desired Quarter value through input box to Pivotfilter Field.
CurQtr = InputBox("Enter Current Quater as : FY2014-Q4 ", "Current Quarter")
If CurQtr = "" Then Exit Sub 'If you Cancel the Inputbox then Macro will exit
If (CurQtr = "FY2014-Q4" Or CurQtr = "FY2015-Q1" Or CurQtr = "FY2015-Q2" Or CurQtr = "FY2015-Q3" Or CurQtr = "FY2015-Q4") Then
' The Following Code will loop through Each item in a Pivot Field and Filter data by a value equals to the CurQtr Input.
For X = 1 To ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems.Count
If InStr(1, ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Value, CurQtr) > 0 Then
ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Visible = True
Else
ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Visible = False
End If
Next
Else
Response = MsgBox("Please give FY0000-Q0 in correct Format !!", vbRetryCancel, "Wrong Input !!")
If Response = vbRetry Then
GoTo QTR:
Else
Exit Sub
End If
End If
'Passing the desired Quarter value through input box to Pivotfilter Field.
CurQtr = InputBox("Enter Current Quater as : FY2014-Q4 ", "Current Quarter")
If CurQtr = "" Then Exit Sub 'If you Cancel the Inputbox then Macro will exit
If (CurQtr = "FY2014-Q4" Or CurQtr = "FY2015-Q1" Or CurQtr = "FY2015-Q2" Or CurQtr = "FY2015-Q3" Or CurQtr = "FY2015-Q4") Then
' The Following Code will loop through Each item in a Pivot Field and Filter data by a value equals to the CurQtr Input.
For X = 1 To ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems.Count
If InStr(1, ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Value, CurQtr) > 0 Then
ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Visible = True
Else
ActiveSheet.PivotTables("PivotTable5").PivotFields("Quarter").PivotItems(X).Visible = False
End If
Next
Else
Response = MsgBox("Please give FY0000-Q0 in correct Format !!", vbRetryCancel, "Wrong Input !!")
If Response = vbRetry Then
GoTo QTR:
Else
Exit Sub
End If
End If
Set PVT_GrandTotal = ActiveSheet.Range("A13").PivotTable.GetPivotData("ExpectedSales")
'This code line will extract the Details for the filtered Quarter data from the Pivot.
PVT_GrandTotal.ShowDetail = True
TargetRange = ActiveSheet.UsedRange.Rows.Count
Range("$A$2:$BF$" & TargetRange).Select
Selection.Copy
ThisWorkbook.Activate
ActiveWorkbook.Sheets("LastWeekSales").Range("$A$2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
TargetFile.Close Savechanges:=True
ActiveSheet.Range("$A$2").Select
ThisWorkbook.Save
End Sub
#--------------------------------------------------------------Thanks--------------------------------------------------------------#
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.