Loop row deletion code through multiple sheets

[Drover123]

Hi All,

How do i get the following code to loop through multiple worksheets in my workbook. I have 1178 worksheets in a workbook and need to delete rows that match certain criteria. Considering each worksheet has over 120 rows I dont want to do each sheet individually. Thanks in advance.

Sub MultipeRowdelete()
Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC

'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)
SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)
On Error Resume Next
Set MyRange = Columns(SearchColumn)
On Error GoTo 0
'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub


MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then
NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, else code will exit", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If
Application.ScreenUpdating = False
'to match the WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'to match a PARTIAL text string use this line
Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlPart)
'to match the case and of a WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
If Not C Is Nothing Then
Set DelRange = C
FirstAddress = C.Address
Do
Set C = MyRange.FindNext(C)
Set DelRange = Union(DelRange, C)
Loop While FirstAddress <> C.Address
End If
'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
Application.ScreenUpdating = True


End Sub

[Bob Phillips]

You have 1178 worksheets? :wot I think I can safely say that your design is wrong.



Sub MultipeRowdelete()
Dim MyRange As Range, DelRange As Range, C As Range
Dim MatchString As String, SearchColumn As String, ActiveColumn As String
Dim FirstAddress As String, NullCheck As String
Dim AC
Dim ws As Worksheet

'Extract active column as text
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)
SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
If MatchString = "" Then

NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
"Type Yes to do so, else code will exit", "Caution", "No")
If NullCheck <> "Yes" Then Exit Sub
End If

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets

On Error Resume Next
Set MyRange = ws.Columns(SearchColumn)
On Error GoTo 0
'If an invalid range is entered then exit
If MyRange Is Nothing Then Exit Sub


'to match the WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'to match a PARTIAL text string use this line
Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlPart)

'to match the case and of a WHOLE text string
'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
If Not C Is Nothing Then

Set DelRange = C
FirstAddress = C.Address
Do
Set C = MyRange.FindNext(C)
Set DelRange = Union(DelRange, C)
Loop While FirstAddress <> C.Address
End If

'If there are valid matches then delete the rows
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
Next ws

Application.ScreenUpdating = True
End Sub
:wot

[Drover123]

Thanks for your response. The spreadsheet was generated by a report - long story. I have run the updated macro you provided but I end up with a "Run time error: 424" Object Required. When I select debug, it points to the fourth line from bottom "If Not DelRange Is Nothing Then DelRange.Entirerow.delete".

Any ideas?

[GTO]

:funnyashe Bob, I do believe you've made my day. No sensible reason why, but the little blue guy at the bottom...I almost peed myself...

[Bob Phillips]

Can you post a single worksheet workbookm to try it with?

[Drover123]

It works with a single worksheet workbook.

[Drover123]

I think it was having problems with some empty sheets at the end of the workbook. I have just taken those empty sheets out and it works brilliantly. Thanks VBA!!!!

[Drover123]

You rock XLD!