Macro to search across multiple columns and delete rows not containing specific value

[JenIT]

Hello - I am trying to create a macro that will look at data and if
there is a specific value in any one of the 4 columns...keep that row
and delete all the others. I have this code working to consider one
column...but I cannot make it work to look at multiple columns for its
selection. Here is my one column code.

' DELETE ALL BUT MSC
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("G2:G9000"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) <> "MSC" 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 '

I have not been able to use G$ as it then deletes my header.
To span the multiple columns looking for MSC in any one of the cells in
E, F, G, or H I have tried replacing the G2 with E2:H9000 or E$:H$ and
if I do this - nothing happens, it's like the piece of code is skipped.


Any help would be greatly appreciated, I have been frustrated with this
for a few days now.

 

[Ron de Bruin]

See
http://www.rondebruin.nl/delete.htm

Try this example that check the whole row for MSC

Sub Example2()
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim StartRow As Long
Dim EndRow As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 2
EndRow = 9000

For Lrow = EndRow To StartRow Step -1

If Application.WorksheetFunction.CountIf(.Rows(Lrow), "MSC") = 0 Then .Rows(Lrow).Delete
' Delete each row if the value "MSC" not exist in the row (It will look in the whole row)

Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

 

[Ron de Bruin]

You can also adapt the union example on my site if you want

 

[Tom Ogilvy]

Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("E2:E9000"), ActiveSheet.UsedRange)
For Each cell In rng
If application.countif( cell.Resize(1,5),"MSC") = 0 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 '

 

[JenIT]

Hello Ron:

Your code worked great. Thank you so much!!! This community is so
helpful!

 

[JenIT]

Hi Tom:

Your code also works great...it is a bit more concise. Thanks for you
efforts! Its great people like you and Ron that help us IT people who
dable in VBS look good at our jobs!

Jenny