Paste from 1 sheet to all sheets in a sheet range then delete rows on all sheets within sheet range based on a filter

[chappy]

I would like to do the following:

1. Copy a fixed data range (A6:AN6000) from a sheet ("SOURCE") to ALL sheets within a defined sheet range.
2. Filter the rows in the sheet range to only those containing "0" in column "AO". The sheets within the sheet range have formula in the next column outside the paste range ("AO6:AO5000") that sets a "1" or "0" based on the following formula

   ((AND($R6>=$R$2,$R6<=$R$3-0.001))+0)

3. Delete the filtered rows containing the "0" value in column "AO"
4. Reset the filter in column "AO" to "1" to show the remaining data.

I have tried to use the code below. However:

• It deletes ALL rows (not just the filtered rows).
• It is also very slow. In this example I have reduced the number of sheets for simplicity but the live version has considerably more sheets in the sheet range which would make it even slower.

If anyone could offer any advice on where this is going wrong and any suggestion to improve the efficiency to speed up the steps it would be most appreciated.

Sub Filter_delete()
   
    'Switch off auto calculate to speed up
    Application.Calculation = xlManual
   
    'Switch off screen updating to hide the macro function from being visible - remove this line if you want to see it
    Application.ScreenUpdating = False
       
    Dim ws As Worksheet
   
        'SET The Sheet Names - MUST Reflect Each Sheet Name Exactly!
        WkSheets = Array("P<5 G 0+", "P 5-10 G 0+", "P 5-10", "P 5-10 G 2+", "P 5-10 G 5+")
   
        'Copy & Paste source data to all sheets in the
        Sheets("SOURCE").Select
        Range("A6:AN5000").Copy
       
        Sheets(Array("P<5 G 0+", "P 5-10 G 0+", "P 5-10", "P 5-10 G 2+", "P 5-10 G 5+")). _
        Select
        Range("A6").Select
        ActiveSheet.Paste
  
    For Each ws In Sheets(Array("P<5 G 0+", "P 5-10 G 0+", "P 5-10", "P 5-10 G 2+", "P 5-10 G 5+"))
        'Field 41 = column "AO"
        ws.Range("$A$5:$AO$5000").AutoFilter Field:=41, Criteria1:="0"
        ActiveSheet.Calculate
        Rows("6:5000").Select
        Selection.Delete Shift:=xlUp
        ws.Range("$A$5:$AO$5000").AutoFilter Field:=41
    Next

End Sub

 

[chappy]

Hi vcoolio & Alex

Thanks to you both for all your help, really appreciate it! The code now works exactly as intended and executes really quickly.

Below is the final code I have used...

Option Explicit 'Very first line ensures that every variable is declared properly.


Sub Filter_delete()

   
    Dim wsS As Worksheet: Set wsS = Sheets("Source")
    Dim ar As Variant: ar = Array("P<5 G 0+", "P 5-10 G 0+", "P 5-10", "P 5-10 G 2+", "P 5-10 G 5+", "P 50-500 G 5+")
    Dim i As Long, sh As Worksheet
        
    'Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    For i = 0 To UBound(ar)
            Set sh = Sheets(ar(i))
            wsS.Range("A6:AO4642").Copy
            sh.[A6].PasteSpecial xlValues
            sh.[A6].PasteSpecial xlFormats
            wsS.Range("AO6:AO4642").Copy
            sh.[AO6].PasteSpecial xlFormulas
            'sh.[A6].PasteSpecial xlPasteValues
               
                With sh.Range("AO6", sh.Range("AO" & sh.Rows.Count).End(xlUp))
                        .Calculate
                End With
           
            Application.Calculation = xlManual
           
                With sh.Range("A6", sh.Range("AO" & sh.Rows.Count).End(xlUp))
                       .Sort sh.[AO6], 1 '---->Sorting will group zero values at the top of the data set.
                End With
           
                With sh.Range("AO5", sh.Range("AO" & sh.Rows.Count).End(xlUp))
                        .AutoFilter 1, 0#
                        .Offset(1).EntireRow.Delete
                        .AutoFilter
                End With
    Next i
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Alex Blakenburg]

Thanks for letting us know and sharing your updated code. Glad we could help.

 

[vcoolio]

Good to see you've sorted it out. As Alex has already said, glad we could help.

Cheerio,
vcoolio.