How to stop Screen Flickering when Code Hides and Unhides Rows

[martystoked]

I already tried the

Application.ScreenUpdating = False

'My Code

Applications.ScreenUpdating = True

Here is my complete code so you get an idea of what is happening:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
  
  Application.ScreenUpdating = False



    Dim slItem As SlicerItem
    Dim slCache As SlicerCache
    Dim NumVal As Double
    Dim AcctManagerNm As String
    Dim rng As Range
    Dim x As Long
    
Worksheets("OfficeScoreCard").Range("E15:E767").EntireRow.Hidden = False
Worksheets("OfficeScoreCard").Range("E18:E767").ClearContents

Set rng = Worksheets("OfficeScoreCard").Range("E15")
Set pt = Target
Set pt = Worksheets("Data").PivotTables("pvt_Census")
Set slCache = ActiveWorkbook.SlicerCaches("Slicer_EmployeeNm1")


With slCache
        For Each slItem In .VisibleSlicerItems
            If slItem.HasData = True Then
                AcctManagerNm = slItem.Name
                NumVal = pt.GetPivotData("Count of EmployeeNm", "EmployeeNm", AcctManagerNm)
                If NumVal > 0 Then
                    x = x + 3
                    rng.Offset(x, 0).Value = AcctManagerNm
                End If
            End If
        Next
    End With
    

Worksheets("OfficeScoreCard").Range("E" & x + 18 & ":E767").EntireRow.Hidden = True


Application.ScreenUpdating = True



End Sub

Thanks in advanced!

[watersev]

hi there, try this as a guess:

Application.ScreenUpdating = False
Application.EnableEvents=False

'My Code

Application.EnableEvents=True
Applications.ScreenUpdating = True

[martystoked]

hi there, try this as a guess:

Application.ScreenUpdating = False
Application.EnableEvents=False

'My Code

Application.EnableEvents=True
Applications.ScreenUpdating = True

Thanks for the guess but I already tried that as well...no dice!

[watersev]

any chance to get the sample file which has that flickering event?

[martystoked]

any chance to get the sample file which has that flickering event?

still new to the forums How do I attach the excel document? and is 10mb too large to attach?

Thanks,

[watersev]

Zipped archive and .xlsb files have allowance of 9.77 MB, for the others - 1 MB.

To attach a file, push the button with the paperclip (or scroll down to the Manage Attachments button), browse to the required file, and then push the Upload button.

[martystoked]

The file should now be attached so you can see what is going on.

Thanks!

[watersev]

you might not need those Application stuff anymore

[martystoked]

Ended up finding this and applying it to my code and it worked!!

http://www.excelforum.com/excel-prog...dowupdate.html

Here is my complete code for reference:

Private Declare Function LockWindowUpdate Lib "user32" _
  (ByVal hwndLock As Long) As Long


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
  LockWindowUpdate Application.Hwnd
  Application.ScreenUpdating = False

  Application.EnableEvents = False
 
  
    Dim slItem As SlicerItem
    Dim slCache As SlicerCache
    Dim NumVal As Double
    Dim AcctManagerNm As String
    Dim rng As Range
    Dim x As Long
    
    
    
Worksheets("OfficeScoreCard").Range("E18:E767").ClearContents

Set rng = Worksheets("OfficeScoreCard").Range("E15")
Set pt = Target
Set pt = Worksheets("Data").PivotTables("pvt_Census")
Set slCache = ActiveWorkbook.SlicerCaches("Slicer_EmployeeNm1")


With slCache
        For Each slItem In .VisibleSlicerItems
            If slItem.HasData = True Then
                AcctManagerNm = slItem.Name
                NumVal = pt.GetPivotData("Count of EmployeeNm", "EmployeeNm", AcctManagerNm)
                If NumVal > 0 Then
                    x = x + 3
                    rng.Offset(x, 0).Value = AcctManagerNm
                End If
            End If
        Next
    End With
    

  
Worksheets("OfficeScoreCard").Range("E15:E767").EntireRow.Hidden = False
   Worksheets("OfficeScoreCard").Range("E" & x + 18 & ":E767").EntireRow.Hidden = True
    
    
Application.ScreenUpdating = True
 
Application.EnableEvents = True
    
LockWindowUpdate ByVal 0&   'simply passing a long value of 0 into the function
    
    
End Sub

[watersev]

yes, I see what you mean. I'll need some time to think of the way to avoid it. Will post back latest tomorrow evening if it's OK with you.

Good point