I found the below VBA code on the internet which is very helpful, but I would like to add an extra step to change the settings on the printer to "Fit All Columns on One Page". How Can I do that?
Sub PrintFirstFilterItems()
'downloaded from contextures.com
'prints a copy of pivot table
'for each item in
'first Report Filter field
On Error Resume Next
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set pf = pt.PageFields(1)
If pf Is Nothing Then Exit Sub
For Each pi In pf.PivotItems
pt.PivotFields(pf.Name) _
.CurrentPage = pi.Name
ActiveSheet.PrintOut 'for printing
'ActiveSheet.PrintPreview 'for testing
Next pi
End Sub
I need the code to change the printer settings to this
I am new on VBA, and all I did was search on google how to change it but nothing worked.
Try the following...
Application.PrintCommunication = False
With ActiveSheet
With .PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End With
Application.PrintCommunication = True
Related
Community, need your help here, other than the fact the macro initially did nothing, I have now an error 1004: Application or object defined error!!
I updated my query to simplify and hoping to correct the no effect result from the macro, but now I made it worst.. any help please
Sub changeFilters()
Dim wsChart As Worksheet: Set wsChart = Sheets("Graph Data")
Dim wsPivot As Worksheet: Set wsPivot = Sheets("PCW_pivot")
Dim pt As PivotTable: Set pt = wsPivot.PivotTables("PCW1")
Dim pf As PivotField: Set pf = pt.PivotFields("[Range].[Geography].[Geography]")
Dim SelGeo As Variant: SelGeo = Sheets("Graph Data").Range("E3").Value
'turn on automatic update / calculation in the Pivot Table
With SelGeo <> "WW"
pt.ManualUpdate = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
pf.PivotFilters.Add Type:=xlCaptionEquals, Value1:="[SelGeo]"
pt.RefreshTable
End With
With SelGeo = "WW"
.ClearAllFilters
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I have a macro that work but it takes too long to complete - 45sec.
What it does is to take a combo box result to update a pivot table filtering.
Do you know what I did wrong and how could I improve it please?:)
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim wsChart As Worksheet
Dim wsPivot As Worksheet
Dim SelGeo As Variant
'turn on automatic update / calculation in the Pivot Table
Set wsChart = ThisWorkbook.Sheets("Graph Data")
Set wsPivot = ThisWorkbook.Sheets("PCW_pivot")
Set pt = ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1")
Set SelGeo = ThisWorkbook.Sheets("Graph Data").Range("SelGeo")
pt.ManualUpdate = True
Application.ScreenUpdating = False
ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1").ClearAllFilters
If ThisWorkbook.Sheets("Graph Data").Range("SelGeo") = WW Then
Exit Sub
End If
For Each pi In pt.PivotFields("Geo").PivotItems
Select Case pi.Name
Case [SelGeo]
pi.Visible = True
Case Else
pi.Visible = False
End Select
Next pi
'turn on automatic update / calculation in the Pivot Table
pt.ManualUpdate = False
Application.ScreenUpdating = True
End Sub
Thank you very much.
You can try turning off calculation. Also, consider testing for the negative of your test... this allows for code that can run from start to end naturally without needed to Exit Sub in the middle
ThisWorkbook.Sheets("PCW_pivot").PivotTables("Pivot_table1").ClearAllFilters
If ThisWorkbook.Sheets("Graph Data").Range("SelGeo") <> WW Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each Pi In pt.PivotFields("Geo").PivotItems
Select Case Pi.Name
Case [SelGeo]
Pi.Visible = True
Case Else
Pi.Visible = False
End Select
Next Pi
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
I am trying to filter a pivot table based on the filter of another pivot table on a different sheet with a different data source.
I have two sheets (Main and Size Actual - Style) and want to filter by "Style". The Main sheet is where I want to choose the styles to filter by and from there I want to have the other sheet update with those selected styles filtered (would help if the filtering occurred with a button). I have changed some code to account for the field (Style) that I want to filter for. Right now I have the Main sheet pivot table resetting to show all values when a filter on style is selected on Size Actual - Style. I need that to be switched and instead of clearing the filter I want it to update with the selected styles from the filter.
Option Explicit
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("Style")
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("Style").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
I am trying to have the filter on the second sheet update its filter based on the selection on the first sheets style filter.
I have this VBA marco which changes all the field values to Product.
Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Application.ScreenUpdating = False
pt.ManualUpdate = True
For Each pf In pt.DataFields
pf.Function = xlProduct
Next pf
pt.ManualUpdate = False
Application.ScreenUpdating = True
Set pf = Nothing
Set pt = Nothing
Set ws = Nothing
End Sub
When when I try changing xlProduct to xlCount.Numbers, the code doesn't work. Any idea how to fix this?
xlCountNums is the proper function.
https://www.thespreadsheetguru.com/blog/2014/8/12/quickly-change-pivot-table-field-calculation-from-count-to-sum
I am trying to show / hide pivot items based on a drop down selection.
If you see the code below, cell S3 is a drop down with options - All, Jan, Feb.. Dec. When I change the drop down, I want to show only the pivot items of the selected month.
What is happening here is, once I set an item visibility to false, I am not able to make it visible again. So, the for each loop below simply ignores those items that have been hidden earlier
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pt As PivotTable, counter
Dim pi As PivotItem, msg, mname
Application.EnableEvents = False
If Target.Address = "$S$3" Then
Application.EnableEvents = False
Set pt = Sheet3.PivotTables(1)
mname = Sheet2.Range("S3").Value
pt.RefreshTable
For Each pi In pt.PivotFields("Values").PivotItems
If InStr(pi, mname) > 0 Or mname = "All" Then
pi.Visible = True
Else
pi.Visible = False
End If
Next pi
End If
Application.EnableEvents = True
End Sub
Screenshot of my Pivot Table
Try the code below (explanation inside the code as commnets):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pt As PivotTable
Dim pi As PivotItem
Dim pf As PivotField
Dim msg As String, mname As String
'Dim counter ' <-- not used in this piece of code
If Target.Address = "$S$3" Then
Application.EnableEvents = False
' set the PivotTable object
Set pt = Sheet3.PivotTables(1)
mname = Target.Value ' <-- you can use the Target object
pt.RefreshTable
' set the PivotField object
Set pf = pt.PivotFields("Values")
pf.ClearAllFilters ' clear all previous filters from "Values"
' if value is "All", show all items, (no need to run the loop)
If mname <> "All" Then
For Each pi In pf.PivotItems
If Not pi.Name Like "*" & mname & "*" Then ' only if the value is not like the month >> hide the PivotItem
pi.Visible = False
End If
Next pi
End If
End If
Application.EnableEvents = True
End Sub