I get a runtime error
Unable to get the PivotTables property of Worksheet class
when I run the following code:
Sub UpdatePivot()
Dim ws As Worksheet, SrcData As String, pvtCache As PivotCache
Dim ws2 As Worksheet, NR As Long, NC As Long, ws3 As Worksheet
Dim pf As PivotField, pt As PivotTable, df As PivotField, str As String
'Set ws = ThisWorkbook.Worksheets("Lisun Data")
Set ws2 = ThisWorkbook.Worksheets("Cover")
Set ws3 = ThisWorkbook.Worksheets("Stockist")
Set pt = ws3.PivotTables("PivotTable3")
Set pt = ws3.PivotTables("PivotTable3")
With pt.PivotFields(" May-17")
.Orientation = xlColumnField
.Function = xlSum
.Position = 1
End With
End Sub
May I know what is wrong?
I did add the data source to a data model beforehand, and I'm not sure what exactly is causing the error.
Try the code below to try and trap your errors, explanations inside the code's comments:
Option Explicit
Sub UpdatePivot()
Dim ws As Worksheet, SrcData As String, pvtCache As PivotCache
Dim ws2 As Worksheet, NR As Long, NC As Long, ws3 As Worksheet
Dim pf As PivotField, pt As PivotTable, df As PivotField, str As String
'Set ws = ThisWorkbook.Worksheets("Lisun Data")
Set ws2 = ThisWorkbook.Worksheets("Cover")
Set ws3 = ThisWorkbook.Worksheets("Stockist")
' 1ST: Trap the Pivot-Table object
On Error Resume Next
Set pt = ws3.PivotTables("PivotTable3")
On Error GoTo 0
If pt Is Nothing Then '<-- Pivot Table does't exist (Pivot Table renamed ?)
MsgBox "Pivot-Table object Error!"
Else ' Pivot-Table object exists
' 2NDT: Trap the PivotField object
On Error Resume Next
Set pf = pt.PivotFields(" May-17")
On Error GoTo 0
If pf Is Nothing Then
MsgBox "Pivot-Field object Error!"
Else
With pf
.Orientation = xlColumnField
.Function = xlSum
.Position = 1
End With
End If
End If
End Sub
Thank you to #Shai Rado for all your feedback, extremely valuable. Also big big thanks to #jeffreyweir, I recorded a macro and found out the answer that I needed. The code for adding any pivot field from a data model is below:
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").CubeFields("[Measures].[Sum of May-17]"), "Sum of May-17"
Related
I have been trying to create a PivotTable using VBA, but it keeps giving me Pan error message in the PivotCache section.
I have three worksheets on a workbook and I intend to use the table in worksheet 1 to create a pivot table and chart on worksheet 3. But I keep getting an error message.
Here is my vba code:
Dim ws As Worksheet
Dim pc As PivotCaches
Dim pt As PivotTable
Dim Rng As Range
Dim wb As Workbook
Set ws = Worksheets("Sheet3")
Set Rng = Worksheets("Sheet3").Range("A58")
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Table1", Version:=xlPivotTableVersion14)
Set pt = pc.CreatePivotTable(TableDestination _
:=Range("A58"), TableName:="PivotTable5", DefaultVersion:= _
xlPivotTableVersion14)
ActiveWorkbook.ShowPivotTableFieldList = True
End Sub
Pivot-Table Data screen-shot
Try the code below, explanation inside the code comments:
Option Explicit
Sub PivotTablefromTable()
Dim wb As Workbook
Dim ws As Worksheet
Dim PTbl As PivotTable
Dim PCache As PivotCache
Dim WorkTbl As ListObject
Dim PTblRng As Range
Dim Rng As Range
Set ws = Worksheets("Sheet3")
Set Rng = ws.Range("A58")
Set WorkTbl = Worksheets("work").ListObjects("Table1") ' <-- set a variable to the "Table1" in sheet "work"
Set PTblRng = WorkTbl.Range '<-- get the range from "Table1"
' set the Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PTblRng)
' Set the Pivot Table (already created in previous macro run)
On Error Resume Next
Set PTbl = ws.PivotTables("PivotTable5")
On Error GoTo 0
If PTbl Is Nothing Then ' <-- pivot table still doesn't exist >> need to create it
' create a new Pivot Table in ws sheet, start from Cell A58
Set PTbl = ws.PivotTables.Add(PivotCache:=PCache, TableDestination:=Rng, TableName:="PivotTable5")
' rest of your code here
Else ' just refresh the Pivot table, with updated Pivot Cache
PTbl.ChangePivotCache PCache
PTbl.RefreshTable
End If
ActiveWorkbook.ShowPivotTableFieldList = True
End Sub
I keep getting a type mismatch error and have tried changing the type a few times. I'm just trying to loop through each worksheet and a specified range to see if that word exists in every cell of that range.
Sub CheckWord()
Dim arrVar As Variant
Dim ws As Worksheet
Dim strCheck As Range
Set arrVar = ActiveWorkbook.Worksheets
'MsgBox (arrVar)
For Each ws In arrVar
If ws.Range("C9:G20").Value = "Word" Then
MsgBox (True)
End If
Next ws
End Sub
When you have a range with many columns, it creates an array.
Taking the array into consideration like so:
Sub CheckWord()
Dim arrVar As Variant
Dim ws As Worksheet
Dim strCheck As Range
Set arrVar = ActiveWorkbook.Worksheets
'MsgBox (arrVar)
For Each ws In arrVar
For each col in ws.Range("C9:G20").Cells
if col.Value = "Word" Then
MsgBox (True)
end if
End If
Next ws
End Sub
You can't get the value of ws.Range("C9:G20") and compare it to one string. You've selected multiple cells. If you want to return True when nay one of these cells contains "Word" or when all of them contain "Word" you'll need to iterate over them.
This is an example of how to return whether or not your range contains "Word" anywhere at least once
Function CheckWord()
Dim arrVar As Variant
Dim ws As Worksheet
Set arrVar = ActiveWorkbook.Worksheets
For Each ws In arrVar
Dim c
For Each c In ws.Range("C9:G20").Cells
If c = "Word" Then
CheckWord = True
Exit Function
End If
Next c
Next ws
End Function
Sub CheckWord()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If Not ws.Range("C9:G20").Find(What:="Word", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) Is Nothing Then MsgBox "Found in " & ws.Name
Next ws
End Sub
My purpose is to create a Pivot Table and further a Pivot Chart out of the Dump data (A1:AE170000) I have. I've attached my code below, which works perfectly fine if I reduce my data to around 60-65k rows, but not otherwise.
It throws Runtime error 13 : Type Mismatch at the line I am setting up my Pivot Cache (PTCache).
Private Sub OptionButton3_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ThisWorkbook.Sheets("Data").Activate
Dim PTCache As PivotCache
Dim PT As PivotTable
'Setting range as my entire data set
Dim PTRange As Range
Set PTRange = Range("A1", Range("A1").End(xlToRight).End(xlDown))
'Adding a new worksheet for Pivot Table and Chart
Dim ws As Worksheet
Set ws = Sheets.Add
ws.Name = "All"
PTRange.Select
ThisWorkbook.Sheets("All").Activate
'Runtime error 13:Type Mismatch at this line while setting PTCache
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PTRange)
Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "All")
With PT
.PivotFields("Name").Orientation = xlPageField
.PivotFields("Rate").Orientation = xlDataField
.PivotFields("Date").Orientation = xlRowField
End With
PT.PivotSelect ("")
Charts.Add
ActiveChart.Location where:=xlLocationAsObject, Name:=PT.Parent.Name
ActiveChart.ChartType = xlLine
ActiveChart.Parent.Top = Range("I7").Top
ActiveChart.Parent.Left = Range("I7").Left
Range("A2").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
From PivotCaches.Create Method (Excel) (my emphasis):
<blah><blah> ... When passing as a range, it is recommended to either use a string to specify the workbook, worksheet, and cell range, or set up a named range and pass the name as a string. Passing a Range object may cause "type mismatch" errors unexpectedly.
Just set up a string var to the external address of the Data worksheet's Range.CurrentRegion property radiating out from A1 and use that.
Option Explicit
Private Sub OptionButton3_Click()
'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim PT As PivotTable, PTCache As PivotCache
Dim PTRange As Range, ws As Worksheet, strRNG As String
strRNG = ThisWorkbook.Worksheets("Data").Cells(1, 1).CurrentRegion.Address(external:=True)
With Worksheets.Add(after:=Sheets(Sheets.Count))
.Name = "All"
Set PTCache = .Parent.PivotCaches.Create(xlDatabase, strRNG)
Set PT = .PivotTables.Add(PTCache, .Range("A1"), "All")
With PT
.PivotFields("Name").Orientation = xlPageField
.PivotFields("Rate").Orientation = xlDataField
.PivotFields("Date").Orientation = xlRowField
End With
PT.PivotSelect ("")
End With
'all the chart stuff here
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I have a bunch of worksheets with only one table in each worksheet. I want to run a code that will unfilter/show all the data of all worksheet. so far i have written below code but it is not giving me the desire result.
dim ws1 as worksheet
On Error Resume Next
For Each ws1 In Worksheets
If ws1.FilterMode = True Then ws1.ShowAllData
Next ws1
On Error GoTo 0
Kindly review the above code and ammend.
Thanks
Salman
You may need to tackle this from the Range.Hidden Property point of view as well as the Worksheet.ShowAllData method. aspect. Data may have been hidden by other means than Range.AutoFilter Method.
Dim w As Long
For w = 1 To Worksheets.Count
With Worksheets(w)
.UsedRange.Cells.EntireRow.Hidden = False
If .AutoFilterMode Then .ShowAllData
End With
Next w
Use AutoFilterMode property..
Dim ws1 As Worksheet
On Error Resume Next
For Each ws1 In Worksheets
If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
Next ws1
On Error GoTo 0
Try this code for your requirement.
Sub test1()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
If Not ws.AutoFilterMode = False Then
ws.AutoFilterMode = False
End If
Next
End Sub
I have an Excel workbook with several hundred pivot tables. All of the pivot tables are using data from an SSAS cube. The tables are all basically structured the same way, but they have different "location" filters. What I want to do is have code that will change a "date" filter for all of the tables so that I do not need to manually update each of the tables. (No, slicers will not work for me). I'm very much new to using VBA, so I'm a bit at a loss. I found this code, which I thought might work, but all it does for me is clear the filters on the other tables...possibly because I'm pulling from an external source? Any help would be greatly appreciated.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each pfMain In ptMain.PageFields
bMI = pfMain.EnableMultiplePageItems
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields(pfMain.Name)
bMI = pfMain.EnableMultiplePageItems
With pf
.ClearAllFilters
Select Case bMI
Case False
.CurrentPage = pfMain.CurrentPage.Value
Case True
.CurrentPage = "(All)"
For Each pi In pfMain.PivotItems
.PivotItems(pi.Name).Visible = pi.Visible
Next pi
.EnableMultiplePageItems = bMI
End Select
End With
bMI = False
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Kindly try the following code.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField`enter code here`
Dim pf As PivotField
Dim pi As PivotItem
Dim pvfilter as string
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
pvfilter = InputBox("Enter the pivot filter string")
For Each pfMain In ptMain.PageFields
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields(pfMain.Name)
With pf
.ClearAllFilters
.CurrentPage = pvfilter
End With
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I would suggest you update this code as subroutine and run this macro whenever you need to apply a filter to pivot tables instead of directly using the code in pivot update event.
Sub Test()
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim pvfilter As String
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
pvfilter = InputBox("Enter the pivot filter string")
For Each pfMain In ptMain.PageFields
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields(pfMain.Name)
With pf
.ClearAllFilters
.CurrentPage = pvfilter
End With
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub