Loop through slicer in pivotable prints too many pages

Malash

New Member
Joined
Jan 21, 2019
Messages
1
I found a vba code that I copied on this forum that lopps through a slicer and selects / deselects each name and bring up the relevant data for that person and prints it. It works but for some reason it keeps creating prints about 104 pages when there are only 39 names in the slicer. The last prints are just some empty boxes. When I manually choose a name in the slicer and preview the printout it shows as 1 page so I should only have 39 pages in total. Why does it not stop?

This is the code that I am using. ( I also added a shape that covers up the slicer and when finished deletes it because even though it picks the next name from the slicer it doesn't actually move the slicer to show that name and so it looks wrong in the print out.)

I hope someone will have an idea why it is happening.

Sub Step_Thru_SlicerItems2()
Dim slItem As SlicerItem
Dim i As Long




ActiveSheet.Shapes.AddShape(msoShapeRectangle, 367.8, 3.6, 159, 54).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Name = "WhiteSquare"
Selection.Name = "WhiteSquare"

Application.ScreenUpdating = False
With ActiveWorkbook.SlicerCaches("Slicer_Student")
'--deselect all items except the first
.SlicerItems(1).Selected = True
For Each slItem In .VisibleSlicerItems
If slItem.Name <> .SlicerItems(1).Name Then _
slItem.Selected = False
Next slItem
Call MyFunction(1)
'--step through each item and run custom function
For i = 2 To .SlicerItems.Count
.SlicerItems(i).Selected = True
.SlicerItems(i - 1).Selected = False
Call MyFunction(i)
Next i
End With
Application.ScreenUpdating = True

ActiveSheet.Shapes.Range(Array("WhiteSquare")).Select
Selection.Delete

End Sub

Function MyFunction(lItem As Long)
Dim wsPivot As Worksheet
Dim lNextRow As Long
Const lRowsPerPic As Long = 11
lNextRow = (lItem - 1) * lRowsPerPic + 1

Sheets("SemReport").PrintOut Copies:=1, Collate:=True, ignorePrintAreas:=False


End Function
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Forum statistics

Threads
1,214,979
Messages
6,122,551
Members
449,088
Latest member
davidcom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top