CODEWITHSUNDEEP
vbaexcel
Andrew Smith
Andrew Smith

Reputation: 47

Deleting Excel cells based on a text string (current code not working)

I am trying to remove all cells in my spreadsheet that have the word TOTAL in them. My current VBA code:

Sub Delete_Rows()
  Dim RNG As Range, cell As Range, del As Range
  Set RNG = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)
  For Each cell In RNG
  If (cell.Value) = "TOTAL" _
  Then
  If del Is Nothing Then
  Set del = cell
  Else: Set del = Union(del, cell)
  End If
  End If
  Next cell
  On Error Resume Next
  del.EntireRow.Delete
End Sub

This isn't working, and I can't understand why. Sorry I am being so vague, but clearly something obvious is eluding me.

Thanks

Upvotes: 0

Views: 3171

Answers (2)

John Bustos
John Bustos

Reputation: 19574

Based upon what we discussed above, here's what you're looking for:

  Sub Delete_Rows()      
  Dim RNG As Range, cell As Range, del As Range      
  Set RNG = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)

     For Each cell In RNG
        If InStr(1, UCase(cell.Value), "TOTAL") > 0 Then
           If del Is Nothing Then
              Set del = cell
           Else
              Set del = Union(del, cell)
           End If
        End If
     Next cell

  On Error Resume Next
  del.EntireRow.Delete

  End Sub

Upvotes: 1

brettdj
brettdj

Reputation: 55692

Code using AutoFilter or Find would be much more efficient than a range loop.

This code from my article Using Find and FindNext to efficiently delete any rows that contain specific text.

Option Explicit

Const strText As String = "TOTAL"

Sub ColSearch_DelRows()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Columns("A").Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

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

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)

    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)

    'c)match string to part of cell, case insensititive
    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2.EntireRow, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    'This sample looks to delete rows that contain the text in StrText AND where column A contains "Duplicate"
    If Not rng2 Is Nothing Then rng2.EntireRow.Delete

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With

End Sub

Upvotes: 0

Related Questions