VBA Excel Application.ScreenUpdating = False not working

What is the code in this Procedure?

The code is shown in the attachment screen-flicker.docx

Sorry I meant in the procedure called during the code

   Three_filters_argument ws

Good Morning

the code applying to Three_filters_argument ws is shown on pages 2 - 7

It is so much easier if you attach an example workbook containing the code.

I have attempted to edit your code but I cannot test it. I am sure that the coding could be improved but you don't add any notes to explain in the code. How will you remember what it is doing when you come back to this code later?

You will have to test this and loet me know if any errors occur and the line they occur on.

Sub Admin_filter_loop()
'from admin list loop through sheets and perform argument three filters
    Dim ws As Worksheet, dws As Worksheet, admWs As Worksheet
    Dim lr As Long, alr As Long, i As Long, dlr As Long
    Dim x
    With Application
        .StatusBar = "MACRO IN PROGRESS please wait......"
        .ScreenUpdating = False
        .DisplayAlerts = False

        Set dws = Sheets("percent upload")
        Set admWs = Sheets("Admin")
        'Inserts headers
        dws.Range("A1:F1").Value = Array("Comments", "Branch", "Line", "Layout", "Section", "Override")
        alr = admWs.Cells(Rows.Count, 2).End(xlUp).Row
        If alr < 5 Then
            MsgBox "There are no sheets listed on Admin Sheet.", vbExclamation, "Sheet List Not Found!"
            Exit Sub
        End If
        x = admWs.Range("B5:B" & alr).Value
        For i = 1 To UBound(x, 1)
            Set ws = Sheets(x(i, 1))
            If Not ws Is Nothing Then
                Three_filters_argument ws
            End If
        Next i

        .ScreenUpdating = True
        .DisplayAlerts = True
        .StatusBar = False
    End With

    MsgBox "Data has been copied to Summary Sheet successfully.", vbInformation, "Done!"
End Sub

'Filters ARGUMENT
'APPLY 3 FILTERS
Sub Three_filters_argument(ws As Worksheet)
' three_filters Macr
    Application.ScreenUpdating = False
    'PERFORM FIRST FILTER
    'switch off auto calcs to speed up code
    Application.Calculation = xlCalculationManual
    Dim rRng As Range

    With ws
        If .AutoFilterMode = True Then
            .Range("A1").AutoFilter    ''/// not sure what you expect the selection to be, amend accordingly
        End If

        xrow = .Cells(.Rows.Count, 27).End(xlUp).Row

        .Range("V5").AutoFilter
        .Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd

        Set filteredrange = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        'if header row or blank exclude otherwise copy visible rows

        headerrow = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
        flag = 0
        For Each rngrow In filteredrange.Rows
            lastrow = rngrow.Row
            If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
                flag = 1
                firstrow = rngrow.Row
            End If
        Next
        If firstrow > 0 Then
            Range("V" & firstrow & ":Z" & lastrow).Copy

            With Sheets("percent upload")

                If .Range("B2").Value = "" Then
                    Set rRng = .Range("B2")
                Else
                    Set rRng = .Range("B1").End(xlDown).Offset(1, 0).Select
                End If

                rRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                         :=False, Transpose:=False
                Application.CutCopyMode = False
            End With
        End If

        'PERFORM SECOND FILTER




        If .AutoFilterMode = True Then
            .Range("A1").AutoFilter
        End If

        xrow = .Cells(.Rows.Count, 33).End(xlUp).Row

        Range("AA5").AutoFilter
        .Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd

        Set filteredrange = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        headerrow = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
        flag = 0
        For Each rngrow In filteredrange.Rows
            lastrow = rngrow.Row
            If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
                flag = 1
                firstrow = rngrow.Row
            End If
        Next
        If firstrow > 0 Then
            .Range("AA" & firstrow & ":AE" & lastrow).Copy

            With Sheets("percent upload")

                If .Range("B2").Value = "" Then
                    Set rRng = Range("B2")
                Else
                    Set rRng = Range("B1").End(xlDown).Offset(1, 0)
                End If

                rRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                         :=False, Transpose:=False
                Application.CutCopyMode = False
            End With
        End If

        'PERFORM THIRD FILTER 7 TIMES i.e each copied set into absolute upload is equivalent to one day

        Dim x



        If .AutoFilterMode = True Then
            .Range("A1").AutoFilter
        End If

        xrow = .Cells(.Rows.Count, 33).End(xlUp).Row

        .Range("AG5").AutoFilter
        .Range("$AG$5:$AH$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd

        Set filteredrange = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        headerrow = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
        flag = 0
        For Each rngrow In filteredrange.Rows
            lastrow = rngrow.Row
            If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
                flag = 1
                firstrow = rngrow.Row
            End If
        Next


        If firstrow > 0 And .Cells(firstrow, "AG") <> "" Then


            Set rRng = .Range("AG" & firstrow & ":AH" & lastrow)

            Let x = 0
            Do While x < 7
                rRng.Copy

                With Sheets("absolute upload")
                    If .Range("A2").Value = "" Then
                        Set rRng = .Range("A2")
                    Else
                        Set rRng = .Range("A1").End(xlDown).Offset(1, 0)
                    End If

                    rRng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False

                    x = x + 1
                End With
            Loop
            '    .Range("a1").Select

        End If

        Application.Calculation = xlCalculationAutomatic
    End With
End Sub

Select allOpen in new window

Good Morning
Thanks for the quick response
Re your comments
Sensitivity issues precluded me attaching the relevant workbook and a mock up would not necessarilly be reflective of the complexity.
When I have a final version of my code I always write up the detail, with comment, in a separate Word Document - just what I do for sensitive workbooks
I will test the code as quickly as I can
Thanks

I have run the code and it successfully extracts the data for filters 1 and 2 but for filter 3 the results are corrupted in that it appears not to be looping through each sheet, that has content, 7 seven times also the extracts are incomplete.
Whereas previously the flickering caused by seeing the sheets as the code was working through has gone  now it flickers between a blank excel sheet and my screen-saver.
The run time remains the same.
There were only 4 de-bugs - surprisingly few considering you had nothing to validate with
I do appreciate the difficulty of your trying to this 'in the dark' and I would understand if you feel this is too constrained.
If you decide to soldier on I have attached the code as it now looks with the debugs ironed out
SCREEN-FLICKER-2.docx

I'll look at it later when I have more time probably tomorrow.

This resolved the previous issue and speeded up performance by c. 20 seconds
Thank you for your perseverance, have learned a lot which can be applied in the future

Thanks for resolving this despite the constraints

Pleased to help, although a workbook would have helped.