CODEWITHSUNDEEP
excelvba
CMProjetIDF
CMProjetIDF

Reputation: 15

How to delete a row if every cell in a range contains the same text

Real project sample here: http://s000.tinyupload.com/?file_id=06911274635715855845

Sample here

its all in the title,

Lets say i got a doc with ten columns and three hundred rows, A and B contain a number and C to J can contain many words and sometimes the word "Banana".

I'd like to automate a task that goes line by line on the worksheet and deletes the whole row if every cell between C and J contains "Banana", ignoring A and B.

Usually when i have such a question i submit my ideas but i'm quite stumped here from the get go.

Would you be kind enough to help?

Upvotes: 0

Views: 78

Answers (2)

FaneDuru
FaneDuru

Reputation: 42236

Try the next code, please. It will delete all rows having the same string in columns C to J ("Banana" inclusive...). It would be very fast. The deletion is done at the end, at once:

Edited:

Since, in an worksheet containing tables, the non contiguous entire rows range deletion is not allowed, I adapted the code to test if such a table is involved, intersect the collected range to be deleted (its EntireRow) with the table and delete the intersected table rows.

Please, test next updated code:

Sub testDeleteRowsSameWord()
  Dim sh As Worksheet, lastRow As Long, i As Long, rngDel As Range
  
  Set sh = ActiveSheet ' use here your necessary sheet
  lastRow = sh.Range("C" & Rows.Count).End(xlUp).Row
  
  For i = 1 To lastRow
    If WorksheetFunction.CountIf(sh.Range("D" & i & ":EA" & i), _
                            sh.Range("D" & i).Value) = 128 Then
        If rngDel Is Nothing Then
            Set rngDel = sh.Range("A" & i)
        Else
            Set rngDel = Union(rngDel, sh.Range("A" & i))
        End If
    End If
  Next i
  If Not rngDel Is Nothing Then
    If sh.ListObjects.Count > 0 Then
        If sh.ListObjects.Count > 1 Then MsgBox _
             "This solution works only for a table...": Exit Sub
        Dim Tbl As ListObject, rngInt As Range
        Set Tbl = sh.ListObjects(1)
        Set rngInt = Intersect(Tbl.Range, rngDel.EntireRow)
        If rngInt.Count > 0 Then
            rngInt.Delete xlUp
        Else
            rngDel.EntireRow.Delete xlUp
        End If
    Else
        rngDel.EntireRow.Delete xlUp
    End If
  End If
End Sub

Upvotes: 2

romulax14
romulax14

Reputation: 555

They are infinite ways to achieve what you want. One for example can be something like :

 Dim i As Integer, j As Integer
 Dim mBanana As Boolean
 For i = 299 To 0 Step -1 'rows 1 to 300
    mBanana = True
    For j = 0 To 7 'columns C to J
        If Sheets("nameofyoursheet").Range("C1").Offset(i, j).Value <> "Banana" Then
            mBanana = False
        End If
    Next j
    If mBanana = True Then
        Sheets("nameofyoursheet").Range("C1").Offset(i, j).EntireRow.Delete
    End If
 Next i

Note that the numbers of rows and columns are hardcoded in the parameters of the For, you can easily adapt the code.

Upvotes: 0

Related Questions