Please help with VBA code

[LiveUser]

What do I need to do to this VBA code so when I start it it applies to the
entire workbook rather than the worksheet?

Thank you.





Option Explicit

Sub KillRows()

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

 

[Roger Govier]

Hi

You would need to wrap your code in a For Next loop.
Add these lines after your existing Dim statements

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Range("E1").Select

your existing code

then before Application.ScreenUpdating=True
put
Next

 

[smw226 via OfficeKB.com]

Hi,

Try iterating through each sheet in the workbook:

Dim wksht As Worksheet

For Each wksht In ActiveWorkbook.Worksheets


<<your code>>


Next wksht


HTH

Simon

What do I need to do to this VBA code so when I start it it applies to the
entire workbook rather than the worksheet?

Thank you.

Option Explicit

Sub KillRows()

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

--
--------------------
Simon - UK

Email at simon22mports [ a t ] hot mail [ d ot ]com

Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/ms-excel/200801/1

 

[LiveUser]

smw226 via OfficeKB.com and Roger Govier,

I didn't have any luck with the code you gave me. I tried moving it around a
bit also, but couldn't get it to work. I don't know what I could be doing
wrong.

 

[Roger Govier]

Hi

I shouldn't have include the line Range("E1").Select

 

[LiveUser]

I still couldn't get it to work. Here is what I have:

Option Explicit

Sub KillRows()

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
For Each ws In ThisWorkbook.Worksheets
ws.Activate

'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

Next

Application.ScreenUpdating = True

End Sub