Remove Rows based on criteria

Hello

I have two sheets in a workbook, I need to create a macro that will search both sheets and if *Load Balance* or "White Noise* is found, then delete that entire row and move the rows below it up.
sandramacAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Quick question..Which column will have these both the values in the worksheet??

Saurabh...
sandramacAuthor Commented:
The data can appear in any Column within A:L
Saurabh Singh TeotiaCommented:
Use this code..Assuming you want to run this macro on sheet1 and sheet2 this will do what you are looking for...

Sub deleteval()
    Dim lrow As Long, rng As Range, cell As Range
    Dim rng2 As Range, ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then
            On Error Resume Next
            lrow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set rng = Range("A1:L" & lrow)
            Set cell = rng.Find("Load Balance", , xlValues, xlPart, xlByRows)
            If Not cell Is Nothing Then
                Set rng2 = cell
                firstaddress = cell.Address
                Do
                    Set cell = rng.FindNext(cell)
                    Set rng2 = Union(rng2, cell)

                Loop While firstaddress <> cell.Address
            End If

            Set cell = rng.Find("White Noise", , xlValues, xlPart, xlByRows)
            If Not cell Is Nothing Then
                If rng2 Is Nothing Then
                    Set rng2 = cell
                Else
                    Set rng2 = Union(rng2, cell)
                End If

                firstaddress = cell.Address
                Do
                    Set cell = rng.FindNext(cell)
                    Set rng2 = Union(rng2, cell)

                Loop While firstaddress <> cell.Address
            End If

            If Not rng2 Is Nothing Then rng2.EntireRow.Delete


        End If
        Set rng = Nothing
        Set cell = Nothing
        Set rng2 = Nothing

    Next ws

End Sub

Open in new window


Saurabh....

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
OWASP: Threats Fundamentals

Learn the top ten threats that are present in modern web-application development and how to protect your business from them.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Another approach is this...
Assuming row1 is the header row on each sheet. If not change the row number in line 8 With ws.Rows(1)
Sub DeleteRows()
Dim ws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
   lr = ws.UsedRange.Rows.Count
   ws.AutoFilterMode = 0
   With ws.Rows(1)
      For c = 1 To ws.UsedRange.Columns.Count
         .AutoFilter field:=c, Criteria1:="=*white noise*", Operator:=xlOr, Criteria2:="=*load balance*"
         If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
            ws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
         End If
         .AutoFilter field:=c
      Next c
   End With
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

sandramacAuthor Commented:
Thank You
Saurabh Singh TeotiaCommented:
sandramac..You are welcome...Always happy to help.. :-)

Saurabh...
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.