VBA Delete Entire Row if Contains Certain Text

[bigmacneb]

I've searched on here, but every code I put in gives me an error back. Data in column D, If any of the cells contains "Record Only" I need it to delete the entire row.
Thanks

 

[Corsa88]

The code in post #74 was for dealing with a text string not a greater than condition as per your question in post #73 which was an autofilter on Column D for a text string with wildcards.

I am not home to write code now but for when I am are you sure what is in post #79 is what you actually want?

Mark,

Yes indeed!

I would like to delete rows based on the cell values in column V row 2 onwards till end of data, which fulfil the criteria : value > 50.

 

[MARK858]

On the screen in front of me 131380 rows with 64512 cells greater than 50 = approx. 1.6 seconds

Sub delme21()
    Dim x, lr As Long, lc As Integer
    Dim a, b() As Variant, i As Long, e, k As Boolean
    Application.ScreenUpdating = False
    e = "Record Only"

    lr = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, _
                                searchdirection:=xlPrevious).Row
    lc = ActiveSheet.Cells.Find("*", searchorder:=xlByColumns, _
                                searchdirection:=xlPrevious).Column

    a = Cells(1, 22).Resize(lr)
    ReDim b(1 To lr, 1 To 1)
    For i = 2 To lr
        If Cells(i, 22).Value > 50 Then
            b(i, 1) = 1
            k = True
        End If
    Next i

    If k = False Then Exit Sub
    Cells(1, lc + 1).Resize(lr) = b
    Cells(1, 1).Resize(lr, lc + 1).Sort Cells(1, lc + 1), 1
    Cells(1, 1).Resize(Cells(1, lc + 1).End(xlDown).Row, lc + 1).Delete 3
    Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

That fast and your using a "loop" I see a lot of people here who dislike loops saying they are slow. I never test the speed of my scripts I just write what I know and hope it's fast enough. Thanks for that bit of information Mark.

On the screen in front of me 131380 rows with 64512 cells greater than 50 = approx. 1.6 seconds

Sub delme21()
    Dim x, lr As Long, lc As Integer
    Dim a, b() As Variant, i As Long, e, k As Boolean
    Application.ScreenUpdating = False
    e = "Record Only"

    lr = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, _
                                searchdirection:=xlPrevious).Row
    lc = ActiveSheet.Cells.Find("*", searchorder:=xlByColumns, _
                                searchdirection:=xlPrevious).Column

    a = Cells(1, 22).Resize(lr)
    ReDim b(1 To lr, 1 To 1)
    For i = 2 To lr
        If Cells(i, 22).Value > 50 Then
            b(i, 1) = 1
            k = True
        End If
    Next i

    If k = False Then Exit Sub
    Cells(1, lc + 1).Resize(lr) = b
    Cells(1, 1).Resize(lr, lc + 1).Sort Cells(1, lc + 1), 1
    Cells(1, 1).Resize(Cells(1, lc + 1).End(xlDown).Row, lc + 1).Delete 3
    Application.ScreenUpdating = True
End Sub

 

[MARK858]

That fast and your using a "loop" I see a lot of people here who dislike loops saying they are slow..

Loops are slow when you are writing to the spreadsheet.

The adapted code (from the code Mirabeau posted) loops through an array in the background then writes to the sheet in one go which is a bit different to the looping we normally try avoiding.

Should've removed the

e = "Record Only"

line as well

 

[kalak]

Loops are slow when you are writing to the spreadsheet.

The adapted code (from the code Mirabeau posted) loops through an array in the background then writes to the sheet in one go which is a bit different to the looping we normally try avoiding.

Should've removed the

e = "Record Only"

line as well

Looking over that code, Mark, it seems you define a memory array "a" but don't make use of it, instead looping through worksheet cells in Col "V", which looping you indicated is likely to be slower than memory looping
Would the modification in red be more in line with your thoughts?

Sub delme21()
    Dim x, lr As Long, lc As Integer
    Dim a, b() As Variant, i As Long, e, k As Boolean
    Application.ScreenUpdating = False
    e = "Record Only"

    lr = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, _
                                searchdirection:=xlPrevious).Row
    lc = ActiveSheet.Cells.Find("*", searchorder:=xlByColumns, _
                                searchdirection:=xlPrevious).Column

    a = Cells(1, 22).Resize(lr)
    ReDim b(1 To lr, 1 To 1)
    For i = 2 To lr
        [COLOR=#ff0000]If a(i, 1) > 50 then     'Cells(i, 22).Value > 50 Then[/COLOR]
            b(i, 1) = 1
            k = True
        End If
    Next i

    If k = False Then Exit Sub
    Cells(1, lc + 1).Resize(lr) = b
    Cells(1, 1).Resize(lr, lc + 1).Sort Cells(1, lc + 1), 1
    Cells(1, 1).Resize(Cells(1, lc + 1).End(xlDown).Row, lc + 1).Delete 3
    Application.ScreenUpdating = True
End Sub

Would this make any difference to your tested speeds?

 

[MARK858]

Would this make any difference to your tested speeds?

Yes kalak, the amendment you suggested over my lazy coding takes the worst run down to roughly 540 milliseconds.

Thanks for your input.

 

[Corsa88]

Yes kalak, the amendment you suggested over my lazy coding takes the worst run down to roughly 540 milliseconds.

Thanks for your input.

Mark and kalak,

Thanks for the code revisions. How can I apply this across entire workbook consisting of multiple sheets?

I tried:

Sub LoopThroughSheets() 
    Dim ws As Worksheet 
    For Each ws In ActiveWorkbook.Worksheets 
        
 
          Dim x, lr As Long, lc As Integer
    Dim a, b() As Variant, i As Long, e, k As Boolean
    Application.ScreenUpdating = False
    e = "Record Only"


    lr = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, _
                                searchdirection:=xlPrevious).Row
    lc = ActiveSheet.Cells.Find("*", searchorder:=xlByColumns, _
                                searchdirection:=xlPrevious).Column


    a = Cells(1, 22).Resize(lr)
    ReDim b(1 To lr, 1 To 1)
    For i = 2 To lr
        If a(i, 1) > 50 then     'Cells(i, 22).Value > 50 Then
            b(i, 1) = 1
            k = True
        End If
    Next i


    If k = False Then Exit Sub
    Cells(1, lc + 1).Resize(lr) = b
    Cells(1, 1).Resize(lr, lc + 1).Sort Cells(1, lc + 1), 1
    Cells(1, 1).Resize(Cells(1, lc + 1).End(xlDown).Row, lc + 1).Delete 3
    Application.ScreenUpdating = True   
         
    Next ws 
End Sub

However it gave me an error. Strange!

 

[MARK858]

However it gave me an error. Strange![/QUOTE

First: what does the error state and what line is highlighted.

Second: Try the code in post #82. Do you still get an error? again if yes what does the error state and what line is highlighted.

I won't be able to look at it until late tonight but it will give me a heads up.

 

[SiuGuy007]

I need to delete rows that have specific text. I tried the codes provided in this thread and it is not working. My spread is 60,000 rows and has data in columns A - AC. The text I am looking for is in column W
(Alive/Well Check). If the code finds this word, I need to delete the entire row. When the code is created is a saved as a module in the spreadsheet?

Than you in advance for your assistance!

Michael

 

[MARK858]

I tried the codes provided in this thread and it is not working.

Define exactly what you mean by not working, does it error, does it do the wrong thing, does it do nothing?
"Not working" in itself is pretty meaningless.

Post an example of the code/codes you tried.