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

New Member
Joined
Jul 18, 2006
Messages
42
Office Version
  1. 365
Platform
  1. Windows
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
    Excel 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.

VBA Code:
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
 
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...

VBA Code:
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
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Good to see you've sorted it out. As Alex has already said, glad we could help.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

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
Back
Top