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
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,670
Messages
5,573,560
Members
412,537
Latest member
Mohamed_5966
Top