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 contains a list of words I need to look up in the main data. I want to delete all rows that DO NOT contain these key words (and move all retaining rows up) and retain only the rows with reference to the keywords (including the titles row). Keywords could be written as text inside any cell which will also contain other text, so the search function needs to look within each string and not be case specific.

I think the code on link below is close, but this is does not refer to a range. Also, I only need to search one worksheet called "FAIR". VBA Looping Over Sheets: Delete rows if cell doesn't contain

I'm a complete novice to VBA so any assistance is extremely appreciated.

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.