I would like to do the following:
End Sub
- Copy a fixed data range (A6:AN6000) from a sheet ("SOURCE") to ALL sheets within a defined sheet range.
- 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)
- Delete the filtered rows containing the "0" value in column "AO"
- Reset the filter in column "AO" to "1" to show the remaining data.
- 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.
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