Hiding Blocks of Pivot Table Rows w/VB. I bit of help PLZ

Jeff9915

New Member
Joined
Feb 8, 2005
Messages
24
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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Jeff9915

New Member
Joined
Feb 8, 2005
Messages
24
ok Since i haven't gotten a response either way i wrote code that works for my sheet that will hide the rows i don't want based on the total field and i'll share it with you all in case any finds it helpfull. It is SUBSTANTIALLY FASTER than deleting 1 row at a time. THANKS!!

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
    Dim d As Long
    Dim rnew 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
    
     val1 = Range("K42") 'sets range for val1
     DeletedRows = 0
     d = 0
     rnew = 6
    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 + 2
            Set MyCell = ws.Cells(r, "a")
            If MyDeleteRange Is Nothing Then
               '- first matching cell
               Set MyDeleteRange = MyCell
            End If
        End If
           
            If DeletedRows <> 0 Then d = d + 2 'keeps counter in sync
            If DeletedRows = 0 Then rnew = rnew + 2 'keeps counter in sync
            
        If DeletedRows <> d Then
        If Not MyDeleteRange Is Nothing Then
            Set MyDeleteRange = Range(MyDeleteRange, MyCell)
            MyDeleteRange.delete
        End If
      ' these below reset variables for zero and correct starting/ending row
      LastRow = LastRow - DeletedRows
      r = rnew
      DeletedRows = 0
      d = 0
      Set MyCell = ws.Cells(r, "a")
      Set MyDeleteRange = Nothing
     
     End If
    r = r + 1
    Next
    '----------------------------------------------------------------
       
    Application.Calculation = xlCalculationAutomatic
            
    
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,018
Messages
5,834,974
Members
430,331
Latest member
Syed Yasir Hannan

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
Top