Creating a pivot table with certain criteria in VBA - vba

When using my macro, the pivot table that already exists does not completely match the other sheet's information, so I am clearing out the pivot table sheet "TJC" and entering a new one from another sheet "TJ". I used a macro recorder to show exactly what I want in the pivot table. I am not sure how to get certain criteria for the table, but if you need more information besides this macro recorder, let me know.
isum.Sheets("TJ").Cells.Select
Selection.delete Shift:=xlUp
Range("H13").Select
Sheets("TJC").Select
Cells.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"TJCust!R1C1:R1048576C7", Version:=6).CreatePivotTable _
TableDestination:="TJCust!R1C1", TableName:="PivotTable1", _
DefaultVersion:=6
Sheets("TJCust").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
ActiveWorkbook.ShowPivotTableFieldList = True
Range("B10").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Item$SV$Item")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Hand_Amount"), _
"Count of Hand_Amount", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Count of Hand_Amount")
.Caption = "Sum of Hand_Amount"
.Function = xlSum
End With

In the code below a pivot table is created and named.
The xlRowFields are your categories (and sub categories).
The xlDataFields are your column data (and type of function on that data) for your categories. Then the Pivot table is sorted based on Column (DataField) values.
There is quite a bit of code exempted from this example, for instance there are new columns built finding averages for each pivot row, and a copy into pretty much a data table for easier formatting of the entire table before it is copied into a report (as a cell based table, not as a pivot any longer)
Option Explicit
'Added this code so you can see where the worksheet is coming from
'Use your own worksheet set up here
Dim CalcSheet as Worksheet
Set CalcSheet = ThisWorkbook.Worksheets("Calc Sheet")
'***************************************
'Make the Sales-Customer Pivot and table
'***************************************
'***************************
'Add Sales Pivot Table
'Also edited to place the Picot in cell A1 of the worksheet that you set up above
'Do not forget to modify the SourceData Range for your intended data range . . .
'Walk through this line by line so you understand what is happening
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
CalcSheet.Range("K14:AY" & LastDR), Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:=CalcSheet.Range("A1"), TableName:="SalesPVT", DefaultVersion _
:=xlPivotTableVersion15
With CalcSheet.PivotTables("SalesPVT").PivotFields("Salesperson")
.Orientation = xlRowField
.Position = 1
End With
With CalcSheet.PivotTables("SalesPVT").PivotFields("Customer")
.Orientation = xlRowField
.Position = 2
End With
With CalcSheet.PivotTables("SalesPVT").PivotFields("DD Rev")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "$#,##0"
End With
With CalcSheet.PivotTables("SalesPVT").PivotFields("Job Days")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
CalcSheet.PivotTables("SalesPVT").PivotFields("Salesperson").AutoSort _
xlDescending, "Sum of DD Rev"
Here is how the Pivot table can be copied, dealing with them on reports is not that much fun when building further calculation columns off the data.
'copy pivot table to get rid of it
CalcSheet.PivotTables("SalesPVT").TableRange1.Copy
'Paste it as values with formatting
CalcSheet.Range("CA100").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
This is deleting the pivot table that was created after copy
CalcSheet.PivotTables("SalesPVT").TableRange1.Delete

Related

Searching multiple sheets for a key word then creating a pivot

I have a code to create the pivot table I need, but I want to add the coding to search each tab for a key word and if found highlight the tab and create the pivot table. Start Search for KeyWord = "XXXXX" in first tab and if found highlight and create pivot below, then continue to next tab, loop until done. If keyword not found do nothing and continue to next tab.
Sub Create pivot()
ActiveSheet.Select
With ActiveWorkbook.ActiveSheet.Tab
.Color = 65535
.TintAndShade = 0
End With
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim pc As PivotCache
Set shtSrc = ActiveSheet
Set shtDest = shtSrc.Parent.Sheets.Add()
shtDest.Name = shtSrc.Name & "-Pivot"
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=shtSrc.Range("A1").CurrentRegion)
pc.CreatePivotTable TableDestination:=shtDest.Range("A3"), _
TableName:="PivotTable1"
With shtDest.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Suspense?")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("APC LC2 Amount"), "Sum of APC LC2
Amount", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Partner LC2 Amount"), "Sum of Partner LC2
Amount", _
xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField
ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("LC2 Amount"), _
"Sum of LC2 amount", xlSum
End Sub

Excel Macro for Pivot Table

So I created a macro to create a basic pivot table in excel. I recorded the macro and have 5 filters. When running the macro the format gets messed up and the filters are listed across columns instead of listed vertically. How do I get the filters listed vertically?
Incorrect Format Image
Correct Format Image
Range("Table1[[#Headers],[Installation]]").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1", Version:=6).CreatePivotTable TableDestination:="Sheet1!R3C1", _
TableName:="PivotTable1", DefaultVersion:=6
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Accountable" & Chr(10) & "Organization")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Installation/Site/Proponent Submittal")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("SRP")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("New Submitter")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Submittal Data Received")
.Orientation = xlPageField
.Position = 1
End With
I don't know if you have an actual Excel table as source. If you did you could do something like as follows (check field name spellings and also I assumed row field was called Base)
Option Explicit
Public Sub CreatePivotFromTable()
Dim table As ListObject
Set table = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
' ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$R$16"), , xlYes).Name = _
' "Table1" ''<======== code for creating table instead if not already present
Sheets.Add
With ActiveSheet
Dim pvt As PivotTable
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
table, Version:=6).CreatePivotTable TableDestination:=.Range("A3"), _
TableName:="PivotTable1", DefaultVersion:=6 'version 6 information may need removing
Set pvt = .PivotTables("PivotTable1")
Dim pvtPageFieldArr()
''Note check spellings of fields below and base is an placeholder name for the field containing Ten Nat Guard etc
pvtPageFieldArr = Array("Accountable Organisation", "Installation/Proponent Submittal", "SRP", "New Submitter", _
"Submittal Data Received", "Base")
Dim fieldName As Long
For fieldName = LBound(pvtPageFieldArr) To UBound(pvtPageFieldArr)
With pvt.PivotFields(pvtPageFieldArr(fieldName))
.Orientation = xlPageField
.Position = 1
End With
Next fieldName
Dim pvtRowFieldArr()
''Note check spellings of fields below and base is an placeholder name for the field containing Ten Nat Guard etc
pvtRowFieldArr = Array("Base")
For fieldName = LBound(pvtRowFieldArr) To UBound(pvtRowFieldArr)
With pvt.PivotFields(pvtRowFieldArr(fieldName))
.Orientation = xlRowField
.Position = 1
End With
Next fieldName
Dim dataFieldArr()
dataFieldArr = Array("Layers Submitted", "New Schema-Compliant Layers", "Schema-Compliant Layers with changes", _
"Schema-Compliant Layers with NO changes", "Empty. Non Compliant. Non-SRP Proponent Submitted by SRP", _
"Layers in Repository", "Repository Layers Checked for QAP Compliance", "# of Repository Layers Checked for QAP Compliance", _
"Total # of QAP Checks Performed", "Total # of QAP Errors Found", "Roll-Up QAP Compliance Total % Accuracy")
Dim currField As String
For fieldName = LBound(dataFieldArr) To UBound(dataFieldArr)
currField = dataFieldArr(fieldName)
pvt.AddDataField pvt.PivotFields(currField), "Sum of " & currField, xlSum
Next fieldName
End With
End Sub
This is where sheet 1 has a table (Created with Ctrl + T when a populated cell in range is selected)
Sheet 1 input:
New sheet output:

VBA code for creating Pivot Table

I have created a macro that builds a pivot table. It runs great but I want to dismiss the circled content in the screenshot provided .. I dont want to have the total inside the pivot. Only at the bottom the Grand Total! I am providing my code and a screenshot. Moreover, is it possible to substitute the "Row Labels" text in column B with "FDD"?
Sub aa()
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Customs_report").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Customs_report"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Customs_report")
Set DSheet = Worksheets("Zeikan")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(6, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(6, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Commodity Code")
.Orientation = xlRowField
.Position = 1
.Name = "Commodity Code"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Location")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Quantity (cases/sw)")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Name = "Sum of Quantity (cases/sw)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Quantity (items)")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.Name = "Sum of Quantity (items)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Net value")
.Orientation = xlDataField
.Position = 3
.Function = xlSum
.Name = "Sum of Net value"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Gross weight (Kg)")
.Orientation = xlDataField
.Position = 4
.Function = xlSum
.Name = "Sum of Gross weight (Kg)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Net weight (Kg)")
.Orientation = xlDataField
.Position = 5
.Function = xlSum
.Name = "Sum of Net weight (Kg)"
End With
End Sub
You can toggle the subtotals:
With PTable.PivotFields("Commodity Code")
.Orientation = xlRowField
.Position = 1
.Name = "Commodity Code"
.Subtotals(1) = True
.Subtotals(1) = False
End With
to change the header, change the table layout to tabular
PTable.LayoutRowDefault = xlTabularRow
before you add the fields. BTW, you should be using PTable rather than ActiveSheet.PivotTables("PivotTable") in the rest of your code.

Inserting a date from a cell into a Pivot table to use it as a filter

Im very new to VBA. I will explain my project.
I have an Excel sheet with a lot of information that I want to filter. For the moment my code looks like this:
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"CREATION_DATE")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique2").PivotFields("AMOUNT"), _
"Nombre de AMOUNT", xlCount
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("STATUS")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"VENDOR_NAME")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"INVOICE_NUM")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"Nombre de AMOUNT")
.Caption = "Somme de AMOUNT"
.Function = xlSum
End With
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"CREATION_DATE").CurrentPage = "08/09/2016"
This code works to extract to filter with the date 08/09/2016.
Now, I would like to make the pivot table get this date in a cell ahead of launching the code.
But I don't want to have to go in to the code every time to change the date I want.
I would like something like this:
Ex: I write "09/09/2016" in cell "A1"
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields( _
"CREATION_DATE").CurrentPage = "A1"
But I am getting a debugging error.
After some testing, I found the cause (on my Excel Book). It was related to formatting the Pivot Field "CREATION_DATE", once I added the following section it worked.
Set PvtFld = PvtTbl.PivotFields("CREATION_DATE")
With PvtFld
.Orientation = xlPageField
.NumberFormat = "dd/mm/yyyy" ' << this line
.Position = 1
End With
And for the full code:
Sub PivotFilterDate()
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
' set your Pivot Table (after created) to a variable
Set PvtTbl = Sheets("PivotSpanish").PivotTables("Tableau croisé dynamique2")
' Set "CREATION_DATE" to a Pivot Field variable
Set PvtFld = PvtTbl.PivotFields("CREATION_DATE")
With PvtFld
.Orientation = xlPageField
.NumberFormat = "dd/mm/yyyy"
.Position = 1
End With
' you can modify your code to change all field setting, like following 2:
With PvtTbl.PivotFields("STATUS")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("VENDOR_NAME")
.Orientation = xlRowField
.Position = 2
End With
' clear previous filters
PvtFld.ClearAllFilters
' --- trapping errors ---
' added a Boolean Flag to trap scenarios where no Pivot Item found that matches the value in Cell A1
Dim PvtItemExists As Boolean
PvtItemExists = False
' check all Pivot items in Pivot Field ("CREATION_DATE")
For Each PvtItem In PvtFld.PivotItems
' check if current Pivot Item equals the value in Cell A1
If PvtItem.Value = CStr(CDate(Range("D1").Value)) Then
PvtItemExists = True
Exit For
End If
Next PvtItem
If PvtItemExists Then
PvtFld.CurrentPage = CStr(CDate(Range("D1").Value))
Else
MsgBox "No data matches for date " & CDate(Range("D1").Value) & " in Pivot Table", vbCritical
End If
End Sub

VBA - Invalid Procedure when Creating Pivot Tables within a Loop

All,
I call this subfunction within a loop in another subfunction. The loop works well without this sub called. When I call this sub, it works fine once, and then, on the second go, I get a "runtime error 5 - invalid procedure call or argument" here.
I have many sheets, each with a table. I want to summarize each table with a pivot table.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
You can see the whole subfunction below.
Sub PIVOT()
Dim pivnm, shtnm, tblnm, dest As String
Application.EnableEvents = False
shtnm = ActiveSheet.Name
tblnm = Range("N2").Value 'I have previously sent the table name to this cell
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
Range("N3") = pivnm
With Range("N3") 'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
dest = shtnm & "!R1C15" 'sets the destination
Sheets(shtnm).Select
Range("C1").Select
'the following was written using the macro recorder, with names replaced by
'variables
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
Sheets(shtnm).Select
Cells(1, 15).Select
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Process text"), "Count of Process text", xlCount
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Column1"), "Sum of Column1", xlSum
With ActiveSheet.PivotTables(pivnm).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
shtnm = vbNullString 'I tried resetting everything. Didn't work
tblnm = vbNullString
pivnm = vbNullString
dest = vbNullString
End Sub
Please let me know if I have left any information out or if there is anything I can do better!
I was asked to attach the loop from the other function - so here it is...It probably looks ridiculous to anyone but me...
While count3 <= count2
DoEvents
Application.StatusBar = "Updating. Sheet " & (count3) & " of 61 complete."
Sheets("Sheet2").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:=Range("O" & CStr(count3)).Value
Range("A1:M" & CStr(count)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.count)
ActiveSheet.Paste
If Range("B2") <> "" Then
ActiveSheet.Name = Range("B2")
tblnm = Range("B2").Value
Sheets(tblnm).Select
Application.StatusBar = "Making Table" & (count3) & " of 61 complete."
While Range("B" & CStr(count4 + 1)) <> ""
count4 = count4 + 1
Wend
Range("N1").Value = count4
DataArea = ("$A$1:$M$" & count4)
DataArea1 = DataArea
ActiveWorkbook.ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
tblnm
ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= _
"=*UF_*", Operator:=xlAnd, Criteria2:="<>*Drive*"
ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:= _
"<>#VALUE!", Operator:=xlAnd
ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort.SortFields.Add Key _
:=Range("M1:M" & CStr(count4)), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call RhidRow
Columns("A:A").EntireColumn.Hidden = True
Columns("B:B").EntireColumn.Hidden = True
Columns("F:F").EntireColumn.Hidden = True
Columns("G:G").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("J:J").EntireColumn.Hidden = True
Columns("K:K").EntireColumn.Hidden = True
Columns("L:L").EntireColumn.Hidden = True
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
While Range("M" & CStr(count5 + 1)) <> ""
count5 = count5 + 1
Wend
Range("N2") = tblnm
With Range("N2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Call PIVOT
Else
ActiveSheet.Delete
End If
Range("A1").Select
count3 = count3 + 1
count4 = 2
count6 = 2
Wend
If your sheet names have spaces in them, you need:
dest = "'" & shtnm & "'!R1C15"
This is untested, but as an idea as to passing parameters:
Sub PIVOT(tblnm As String, ws As Worksheet)
Dim pivnm As String
Dim shtnm As String
Dim dest As String
Dim PT As PivotTable
Application.EnableEvents = False
With ws
shtnm = "'" & .Name & "'"
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
With .Range("N3")
.Value = pivnm
'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
dest = shtnm & "!R1C15" 'sets the destination
'the following was written using the macro recorder, with names replaced by
'variables
Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable( _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10)
With PT
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Process text"), "Count of Process text", xlCount
.AddDataField .PivotFields("Column1"), "Sum of Column1", xlSum
With .DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
End With
End Sub
and the calling code would use something like:
Call PIVOT(tblnm, wks)
where wks is a Worksheet variable set to whichever sheet has the data.