Delete rows if not containing one of the value in a list

Question

I am new to VBA, I am trying my best to explain what I want to do

I need to check sheet 1 and sheet 2 if they have value "AAA" or "BBB" or "CCC" in the row, I want to keep it, if not, delete the entire row

My below code can only help me to remove rows except it contains "AAA" in column Q

i don't know how to add more value like "BBB" & "CCC", if the row have these value, either one, I would like to keep it

how to add more columns to check ? now is only checking in column Q, if I want to check it from column H to R ?

i actually have 10 values (AAA, BBB, CCC .... JJJ) want to keep, do I need to type them out one by one , or there is a method to ask excel to check a list, if any cell in Sheet 1 and Sheet 2 matched with any one from these 10 values, keep the row, otherwise, delete the entire row

the list is locate at Sheet 3 from column A1 :A10

thanks ! my code as below

Sub RemoveCell()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

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


With Sheets("Sheet1")


    .Select


    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False

    'Set the first and last row to loop through
    Firstrow = .UsedRange.Cells(1).Row
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

    'loop from Lastrow to Firstrow (bottom to top)
    For Lrow = Lastrow To Firstrow Step -1

        With .Cells(Lrow, "Q")

            If Not IsError(.Value) Then

                If .Value <> "AAA" Then .EntireRow.Delete


            End If

        End With

    Next Lrow

End With

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

End Sub

Just as you loop through rows you should loop through columns as well. First defining the last column that has data and then step through them. To add BBB and CCC you should look into the OR operator within an IF statement. — Luuklag
Welcome to SO, please take the tour (click it) to learn how this community works! ;) — R3uK

R3uK R3uK · Accepted Answer · 2017-03-08T09:12:58

Here, you'll just have to use it like this :

Sub Test_CheL()
    '''Tune the parameters to fit your need : Sheet1 and AAA/BBB/CCC/JJJ
    Call DeleteRowsNotContaining(ThisWorkbook.Sheets("Sheet1"), "AAA/BBB/CCC/JJJ")
End Sub

I've added a few things to improve performances and stability :

EnableEvents = False ,
redisplay PageBreaks after removing rows,
few Exit Fors to avoid keeping looping when you have enough to go on
store cell's value into a variable to improve performance while testing against values of the array

Code to remove rows not containing any value in a list :

Sub DeleteRowsNotContaining(wS As Worksheet, ValuesToKeep As String)
Dim FirstRow As Long
Dim LastRow As Long
Dim LastColInRow As Long
Dim LoopRow As Long
Dim CalcMode As Long
Dim ViewMode As Long

Dim VtK() As String
Dim i As Integer
Dim KeepRow As Boolean
Dim CelRg As Range
Dim CelStr As String

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

VtK = Split(ValuesToKeep, "/")

With wS
    .Select
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    .DisplayPageBreaks = False

    '''Set the first and last row to loop through
    FirstRow = .UsedRange.Cells(1, 1).Row
    LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

    '''Loop from Lastrow to Firstrow (bottom to top)
    For LoopRow = LastRow To FirstRow Step -1
        '''If you don't find any of your values, delete the row
        KeepRow = False
        LastColInRow = .Cells(LoopRow, .Columns.Count).End(xlToLeft).Column

        With .Range(.Cells(LoopRow, "A"), .Cells(LoopRow, LastColInRow))
            For Each CelRg In .Cells
                '''If cell contains an error, go directly to the next cell
                If IsError(CelRg.Value) Then
                Else
                    CelStr = CStr(CelRg.Value)
                    For i = LBound(VtK) To UBound(VtK)
                        If CelStr <> VtK(i) Then
                        Else
                            '''Cell contains a value to keep
                            KeepRow = True
                            Exit For
                        End If
                    Next i
                    '''If you already found a value you want to keep, go next line
                    If KeepRow Then Exit For
                End If
            Next CelRg
            '''Check if you need to delete the row
            If Not KeepRow Then .EntireRow.Delete
        End With '.Range(.Cells(LoopRow, "A"), .Cells(LoopRow, LastColInRow))
    Next LoopRow
    .DisplayPageBreaks = True
End With 'wS

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

Delete rows if not containing one of the value in a list

2 Answers