vba deleting rows that do not contain set values defined in range

Question

I have a sheet of data with 25k lines. I need to search the entire sheet for certain words that I\'ve defined in a named range on tab 2, called \"KeywordSearh\". The range conta

Answer 1

Here is a non VBA way to do it. Select the range you want to alter, go to conditional formatting > highlight cell rules > more rules > use formula to determine which cells to format. Select a color to highlight the cells and type this formula with your ranges:

=COUNTIF(FAIR!$A$1:$A$10,A1) where FAIR!$A$1:$A$10 is your keyword range and A1 is the first cell of the range you are trying to alter.

You can then filter your list by color = no fill, select and delete only visible cells (Ctrl+G > Special > Visible Cells Only).

Answer 2

The procedure below searches your entire worksheet for an array of values and then deletes all rows in the worksheet where those values are not found.

This code is adapted from another site, for some reason I could not paste the link here.

First you need to create a function to find the last row:

    Public Function GetLastRow(ByVal rngToCheck As Range) As Long

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

    If rngLast Is Nothing Then
        GetLastRow = rngToCheck.Row
    Else
        GetLastRow = rngLast.Row
    End If

End Function

Now, use the code below to find the values on an array. It will search the entire worksheet and delete any row where that value is not found.

    Sub Example1()

    Dim varList As Variant
    Dim lngarrCounter As Long
    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String

    Application.ScreenUpdating = False

    varList = VBA.Array("Here", "There", "Everywhere") 'You will need to change this to reflect your Named range

    For lngarrCounter = LBound(varList) To UBound(varList)

        With Sheets("Fair").UsedRange 'Change the name to the sheet you want to filter
            Set rngFound = .Find( _
                                What:=varList(lngarrCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)

            If Not rngFound Is Nothing Then
                strFirstAddress = rngFound.Address

                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                End If

                Set rngFound = .FindNext(After:=rngFound)

                Do Until rngFound.Address = strFirstAddress
                    If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngarrCounter

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

Let me know if you need further assistance.