2

Someone please help. I'm trying to write a VBA code that searches for a particular word "DR" in my excel worksheet column "D" and then delete the entire row. There are lots of occurrences of the particular word in the worksheet. All I want to do is to search for the these occurrences and then delete the entire rows that contains those words. My problem is that I'm not sure what loop structure to use. Below is the code I'm using.

    Columns("D:D").Select
    Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
Do Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.EntireRow.Delete Loop While (Cells.Find(What:="DR"))

I'll be glad for an assistance.

user2865838
  • 31
  • 1
  • 1
  • 5

3 Answers3

6

Another Way (the fastest way)

Let's say your worksheet looks like this

enter image description here

You can use the Excel to do the dirty work ;) Use .AutoFilter

See this code

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim strSearch As String

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    '~~> Search Text
    strSearch = "DR"

    With ws
        '~~> Remove any filters
        .AutoFilterMode = False

        lRow = .Range("D" & .Rows.Count).End(xlUp).Row

        With .Range("D1:D" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With
End Sub

Output:

enter image description here

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • How come is that the fastest way? – CustomX Oct 10 '13 at 08:07
  • 2
    @t.thielemans: 2 reasons. `1` You are not looping and deleting the rows in a loop `2` Autofilter is faster than Looping if there is a huge data. Give it a try and use a timer to time it :) – Siddharth Rout Oct 10 '13 at 08:18
  • @Bhart: I am deleting my comments up till `Oooh :) Thanks for the tip! – t.thielemans` so that this post doesn't appear to be cluttered. :) Request you to to the same :@t.thielemans – Siddharth Rout Oct 10 '13 at 09:29
  • @siddharth-rout: I re-ran all of them again with ScreenUpdating off on all of them... Thielemans and Mine (2nd example) took between 29-30 seconds, Sid - yours took between 40-50 seconds... I alternated between each of us and ran them about 3 times each... – B Hart Oct 10 '13 at 09:38
  • @BHart: No idea.. I deleted the file LOL. I thought that the testing is over. Let me recreate it :P – Siddharth Rout Oct 10 '13 at 09:41
2

Clean and simple, does the trick! ;)

LastRow = Cells(Rows.Count, "D").End(xlUp).Row

For i = LastRow To 1 Step -1
   If Range("D" & i).Value = "DR" Then
      Range("D" & i).EntireRow.Delete
   End If
Next i
CustomX
  • 9,948
  • 30
  • 85
  • 115
  • 1
    Given that the original code uses `LookAt:= xlPart` the code above will not work as desired. Using `If Range("D" & i).Value Like "*DR*" Then` should work, but I've not tested it. – Matti Wens May 14 '18 at 12:19
1

Also another method using Find...

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
    If Not rFind Is Nothing Then
        sFirstAddress = rFind.Address
        Do
            If rDelete Is Nothing Then
                Set rDelete = rFind
            Else
                Set rDelete = Application.Union(rDelete, rFind)
            End If
            Set rFind = .FindNext(rFind)
        Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

        rDelete.EntireRow.Delete

    End If
End With
Application.ScreenUpdating = True
End Sub

The below example is similar but it starts at the bottom and works its way to the top in reverse order. It deletes each row at a time instead of all at once.

Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String

strSearch = "DR"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("D:D")
    Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not rFind Is Nothing Then
        Do
            Set rDelete = rFind
            Set rFind = .FindPrevious(rFind)
            If rFind.Address = rDelete.Address Then Set rFind = Nothing
            rDelete.EntireRow.Delete
        Loop While Not rFind Is Nothing
    End If
End With
Application.ScreenUpdating = True
End Sub
B Hart
  • 1,108
  • 11
  • 20