I wrote and borrowed some of this code, thanks to you all here. I wanted to speed up hiding rows in a simple Pivot table that is only dependent on the Total column value. 1 line/item This code worked in a regular worksheet but I'm not allowed to hide mutiple rows that are not together. ie i cannot hide rows 1:3, 7:10 leaving only rows 4,5,6 visible. It would really speed things up if i can hide multiple blocks of data. Or even blocks of data for that matter. I get " You cannot hide this selection" as the error with this code. What would be the best work around. Thanks All!!!
Code:
Sub ptrows()
Dim tval
Dim val1
Dim pmon As String
Dim MyDeleteRange As Range ' sets range for deletion
'Dim DeletedRows As Long
Dim MyCell As Range ' single cell added to MyDeleteRange
Dim LastRow As Long
Dim ws As Worksheet
Dim Foundcell As Object
Dim r As Long
Sheet8.Activate
Range("D2").Select
pmon = ActiveCell
Sheet8.Activate
ActiveSheet.PivotTables("PivotTable1").RefreshTable
Range("A5").Select
Selection.ShowDetail = False
Range("a6").Activate
ActiveSheet.PivotTables("PivotTable1").PivotFields("Month").CurrentPage = pmon 'Sets Pivot Month
ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").CurrentPage = _
"(All)" 'sets fields to all
'tval = ActiveCell.Offset(0, 8)
val1 = Range("K42") 'sets range for val1
Set ws = ActiveSheet
'- find last row
Set Foundcell = ActiveSheet.Cells.Find(what:="*", _
after:=Range("I65536"), searchdirection:=xlPrevious)
LastRow = Foundcell.Row
'----------------------------------------------------------------
'- check cells
For r = 6 To LastRow
If Not (ws.Cells(r, "i") > val1) And Not (ws.Cells(r, "i") < -val1) Then
DeletedRows = DeletedRows + 1
Set MyCell = ws.Cells(r, "i")
If MyDeleteRange Is Nothing Then
'- first matching cell
Set MyDeleteRange = MyCell
Else
'- add subsequent matching cells to the range
Set MyDeleteRange = Union(MyDeleteRange, MyCell)
End If
End If
'- Hide Data in the range
Next
'----------------------------------------------------------------
If Not MyDeleteRange Is Nothing Then
MyDeleteRange.delete
End If
Application.Calculation = xlCalculationAutomatic
End Sub