Deleting or keeping multiple rows by a specific word content

Question

I'm trying to write a code that either deletes or keeps rows by a specific word input by the end-user.

I've created two button actions:

Sub Button1_Click()
Dim cell As Range
word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
For Each cell In Selection
    cell.EntireRow.Hidden = (InStr(1, cell, word1, 1) = 0) 'keep by a word input by the user
Next
End Sub

Sub Button2_Click()
Dim cell As Range
word2 = InputBox("Enter a word by which you want to delete rows", "Enter")
For Each cell In Selection
    cell.EntireRow.Hidden = (InStr(1, cell, word2, 1) = 1) 'delete by a word input by the user
Next
End Sub

However, these buttons don't work quite the way I would like them to do.

Problems:

1) I have to specifically select the cells in the column of the text to be searched; if I select the whole block of data,everything will be deleted.

2) Actually, the program would be handier, if it did its magic from the cell J22 onwards (to the right and downwards) until the end of the data is reached, without the need to select anything. What is the best way to do this?

3) If I use these buttons several times sequentially, the rows that I've already deleted keep popping up again. How to make the delete "permanent" each time I use one of these buttons? By changing Hidden to Delete I start to get run-time errors.

Answer 1

When you attempt to delete permanently the macro deletes a row, shifts all of the other rows up one to accomodate and this disrupts the flow of your 'For Each...Next'.

There are a couple of ways around this either way it very much changes the shape of your code.
One of them is to add the rows you wish to delete to a union during the loop and then delete the union outside of the loop (example A below). In any case it sounds like you want to specify the range you want this code to work on so I've incorporated that into each example.

Example A

Sub Button1_Click()
Dim endR As Integer, endC As Integer        'depending on size of sheet may need to change to Long
Dim cell As Range, rng As Range, U As Range
Dim ws As Worksheet

Set ws = Sheets(2) ' change accordingly

endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count

Set rng = Range(ws.Cells(22, 10), ws.Cells(endR, endC))  ' from cell J22 to last used row of the last used column on the right

word1 = InputBox("Enter a word by which you want to keep rows", "Enter")

For Each cell In rng
    If InStr(1, cell, word1, 1) = 0 Then
      If U Is Nothing Then     ' for the first time the code finds a match 
        Set U = cell.EntireRow  ' add row to be deleted to U variable
      Else
        Set U = Union(U, cell.EntireRow) ' for any subsequent matches, add row to be deleted to Union
    End If
End If
Next

U.Delete

End Sub

The other way to do it would be to define the exact ranges you want to work with at the start of your code and then loop backwards through that range using loop control variables instead of for each, that way when you delete a row, the shift up doesn't impact the loop.

Sub Button2_Click()

Dim r As Integer, c As Integer
Dim endR As Integer, endC As Integer
Dim cell As Range, rng As Range
Dim ws As Worksheet

Set ws = Sheets(2) ' change accordingly

endC = ws.UsedRange.Columns.Count

word2 = InputBox("Enter a word by which you want to delete rows", "Enter")

For c = 10 To endC      ' start from J and move to the right
  endR = ws.UsedRange.Rows.Count ' after each column has been dealt with, re-evaluate the total rows in the worksheet
    For r = endR To 22 Step -1    ' start from the last row and work up
        If InStr(1, ws.Cells(r, c), word2, 1) = 1 Then
            ws.Cells(r, c).EntireRow.Delete
        End If
    Next r
Next c

End Sub

Answer 2

1. With your current code, if you select the whole block of data, it checks each cell in that selection individually and acts accordingly. If you have a range selected like A1:J1,000, it will hide every row unless each cell in every row of the selection contains the input word.
2. Depending on what you exactly want, you could try something Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.count, 10).End(xlUp).Row this returns the rownumber of the last cell in column 10(J), more examples of this in the code below
3. This is caused by the for loop and the deletion of rows, say For i = 1 To 100 you check cells A1 to A100, if you then delete a row during that loop, the loop will still continue to 100 and not end at 99, the end of the loop is set before the loop starts and does not change during the loop. More information on that and it's solutions here.

General

• Avoid the .Select/.Activate methods and .Selection property, it is a source of many bugs.
• Declare all your variables, use Option Explicit to enforce this.

Here is the refactored code with annotations.

Option Explicit

Sub Button1_Click()
'Keep rows based on input


    'Declaration of variables
    Dim i As Long
    Dim strFilterWord As String
    Dim rngCell As Range
    Dim rngToDelete As Range, rngRow As Range
    Dim arrRow() As Variant, arrTmp() As Variant

    'Setting the filter word
    strFilterWord = InputBox("Enter a word by which you want to keep rows", "Enter")

    With ThisWorkbook.Worksheets("Sheet1") 'Replace "Sheet1" with the actual name of your sheet.
        'Setting up for loop, currently range to loop over is J22:J(lastrow with data)
        For Each rngCell In .Range(.Cells(22, 10), .Cells(Rows.Count, 10).End(xlUp))
            'All values of the current row are combined into an array

            'Determining and setting the range of the current row
            Set rngRow = rngCell.Resize(1, 3)
            'Populate a tmp array with the row range values
            arrTmp = rngRow

            'To use the array, it needs to be 1D, currently it is 2D, section below accomplishes this
            'resize the final array
            ReDim arrRow(LBound(arrTmp, 2) To UBound(arrTmp, 2))
            'Copy values to final array
            For i = LBound(arrTmp, 2) To UBound(arrTmp, 2)
                arrRow(i) = arrTmp(1, i)
            Next i

            'the final array is combined to a single string value with " "(spaces) between each array element
            'if the filterword is not found in the string Instr returns a 0
            'If the filterword is found in the string InStr returns a number corresponding to the start position.
            If InStr(1, Join(arrRow, " "), strFilterWord, vbTextCompare) = 0 Then
                'Test to see if the range to delete is empty or not
                If rngToDelete Is Nothing Then
                    'If the range is empty, it is set to the first row to delete.
                    Set rngToDelete = rngCell.EntireRow
                Else
                    'if the range is not empty, the row to delete is added to the range.
                    Set rngToDelete = Union(rngToDelete, rngCell.EntireRow)
                End If
            End If
        Next rngCell

        'After all cells are looped over, the rows to delete are deleted in one go
        If Not rngToDelete Is Nothing Then rngToDelete.Delete
    End With

End Sub

Sub Button2_Click()
'Keep rows based on input


    'Declaration of variables
    Dim i As Long
    Dim strFilterWord As String
    Dim rngCell As Range
    Dim rngToDelete As Range, rngRow As Range
    Dim arrRow() As Variant, arrTmp() As Variant

    'Setting the filter word
    strFilterWord = InputBox("Enter a word by which you want to delete rows", "Enter")

    With ThisWorkbook.Worksheets("Sheet1") 'Replace "Sheet1" with the actual name of your sheet.
        'Setting up for loop, currently range to loop over is J22:J(lastrow with data)
        For Each rngCell In .Range(.Cells(22, 10), .Cells(Rows.Count, 10).End(xlUp))
            'All values of the current row are combined into an array

            'Determining and setting the range of the current row
            Set rngRow = rngCell.Resize(1, 3)
            'Populate a tmp array with the row range values
            arrTmp = rngRow

            'To use the array, it needs to be 1D, currently it is 2D, section below accomplishes this
            'resize the final array
            ReDim arrRow(LBound(arrTmp, 2) To UBound(arrTmp, 2))
            'Copy values to final array
            For i = LBound(arrTmp, 2) To UBound(arrTmp, 2)
                arrRow(i) = arrTmp(1, i)
            Next i

            'the final array is combined to a single string value with " "(spaces) between each array element
            'if the filterword is not found in the string Instr returns a 0
            'If the filterword is found in the string InStr returns a number corresponding to the start position.
            If InStr(1, Join(arrRow, " "), strFilterWord, vbTextCompare) > 0 Then
                'Test to see if the range to delete is empty or not
                If rngToDelete Is Nothing Then
                    'If the range is empty, it is set to the first row to delete.
                    Set rngToDelete = rngCell.EntireRow
                Else
                    'if the range is not empty, the row to delete is added to the range.
                    Set rngToDelete = Union(rngToDelete, rngCell.EntireRow)
                End If
            End If
        Next rngCell

        'After all cells are looped over, the rows to delete are deleted in one go
        If Not rngToDelete Is Nothing Then rngToDelete.Delete
    End With

End Sub

Answer 3

This should do the trick

 Option Explicit

 Sub DeletingRowContainingSpecificText()

      Dim DataWorkSheet As Worksheet
      'Change "ThisWorkBook" an "Sheet1" as you require
      Set DataWorkSheet = ThisWorkbook.Worksheets("Sheet1")

      Dim LastRow As Long
      Dim LastColumn As Long

      With DataWorkSheet.UsedRange
           LastRow = .Rows(.Rows.Count).Row
           LastColumn = Columns(.Columns.Count).Column
      End With

      Dim word1 As String

      word1 = InputBox("Enter a word by which you want to keep rows", "Enter")

      Dim RowRange As Range
      Dim RowReference As Long
      Dim RowContent As String
      Dim WordFound As Variant

      'When ever you are deleting you need to start at the end and work your way back
      'Otherwise the row after the row you deleted becomes the current row
      For RowReference = LastRow To 22 Step -1
           'Setting the Row Range from Column J to the end for a specific row
           Set RowRange = ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowReference, "J"), Cells(RowReference, LastColumn))

           Set WordFound = RowRange.Find(What:=word1, LookIn:=xlValues)

           If Not WordFound Is Nothing Then
                'Choose if you want to delete or hidden
                RowRange.EntireRow.Hidden = True
                RowRange.EntireRow.Delete
           End If

      Next RowReference

 End Sub

Just paste the Sub Content into your Button1_Click Sub. Otherwise paste this into your WorkBook Module and then test if it is working first.

I did test it and it worked for me.

NB when working with Deleting Rows or Columns always start at the end of the list and work your way to the beginning, this way the reference doesn't get messed up.

Answer 4

the problem resides in using Selection. You should avoid it at all costs!

If the data always is in the same region, this becomes quite simple. Try something like:

Sub Button1_Click()
Dim cell As Range
Dim rData as Range

'Assigns the range for J22 and adjacent rows and columns
Set rData = ActiveSheet.Range("J22").CurrentRegion

word1 = InputBox("Enter a word by which you want to keep rows", "Enter")
For Each cell In rData
    If (InStr(1, cell, word1, 1) = 0) then cell.EntireRow.Delete
Next cell

End Sub

As you are not using Selection anymore, your 3 points get solved