Remove all rows EXCEPT those with specific string in specific column

Hi there,

Take a look at the attached version of your workbook and see if it does what you need. It uses the following code:

Option Explicit


Sub RemoveAllExcept()

    Const sTEXT_TO_KEEP As String = "sup"
    Const sTYPE_HEADER  As String = "Type"
    Const sSHEET_NAME   As String = "Sheet1"
    Const sTABLE_NAME   As String = "tblData"

    Dim rTypeColumn     As Range
    Dim iNoOfRows       As Integer
    Dim wksTarget       As Worksheet
    Dim lobData         As ListObject
    Dim iRowNo          As Integer

    Set wksTarget = ThisWorkbook.Worksheets(sSHEET_NAME)
    Set lobData = wksTarget.ListObjects(sTABLE_NAME)

    Set rTypeColumn = lobData.ListColumns(sTYPE_HEADER).DataBodyRange

    iNoOfRows = rTypeColumn.Rows.Count

    For iRowNo = iNoOfRows To 1 Step -1

        If rTypeColumn.Cells(iRowNo, 1).Value <> sTEXT_TO_KEEP Then
            lobData.DataBodyRange.Rows(iRowNo).Delete
        End If

    Next iRowNo

End Sub

The highlighted values may be altered to suit your requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

Hi Greg M.

Works perfectly! Even allows for easy adjustment to allow for more than one exception strings.

Thanks again!

Hi again,

Many thanks for your very prompt feedback and also for the Reputation increase - much appreciated!

You're welcome - glad I was able to help.

Best regards,

Greg M