Extend VBA code to multiple sheets

[Drewsy]

Morning all,

I have created a code that allows me to remove rows based on a certain criteria.

My limited VBA skills are now evident, as i need to extend this code across the entire workbook but have come a cropper!

The code is as follows:

Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A16:W40000"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) = "Not current" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

How do i loop the code to cover multiple worksheets?

Any help would be greatly appreciated!

Thanks.

 

[royUK]

Something like this

Option Explicit


Sub Delete_Rows()
    Dim ws As Worksheet
    Dim rng As Range, cell As Range, del As Range


    For Each ws In ThisWorkbook.Worksheets
        Set rng = Intersect(ws.Range("A16:W40000"), ws.UsedRange)
        For Each cell In rng
            If (cell.Value) = "Not current" _
               Then
                If del Is Nothing Then
                    Set del = cell
                Else: Set del = Union(del, cell)
                End If
            End If
        Next cell
    Next ws
    On Error Resume Next
    del.EntireRow.Delete
End Sub

Depending on the data layout you would probably find automating AutoFilter much faster

 

[erik.van.geit]

Hi, WELCOME to the Board!

You will find what you need in this thread about worksheets stuff

kind regards,
Erik

PS: please use CODE tags to display code in the future.

 

[L. Howard]

Perhaps set your sheets to an array.

This is untested but gives you an idea how to get started. I show three sheets in the array, you can add more. You will need to add the sheets by their actual name and in the format as you see it. "My Sheet Name", (Note the comma delimiter between sheet names only.)

Option Explicit

Sub Delete_Rows()
 Dim rng As Range, cell As Range, del As Range
  Dim MyArr As Variant
 
 MyArr = Array("Sheet2", "Sheet3", "Sheet4")

  For i = LBound(MyArr) To UBound(MyArr)
     With Sheets(MyArr(i))
         Set rng = Intersect(Range("A16:W40000"), ActiveSheet.UsedRange)
       For Each cell In rng
          If (cell.Value) = "Not current" Then
             If del Is Nothing Then
               Set del = cell
              Else: Set del = Union(del, cell)
             End If
           End If
       Next cell
         On Error Resume Next
         del.EntireRow.Delete
  Next ' i
End Sub

Regards,
Howard

 

[erik.van.geit]

Perhaps set your sheets to an array.

To avoid confusion: since Drewsey stated

across the entire workbook

the code provided first will be the most suited to your needs.

best regards,
Erik