Deleting Rows By Value In a Column - VBA Not Working 100% - HELP IS APPRECIATED

[kescco]

Okay,

I have about 50 rows data and I would like to delete all rows containing the word "Apple" in Column J.

This code gets most values but not all.

Please help.


Sub DeleteAPPLERows() 'or Button1_Click()
Dim Rng As Range, Cell As Range
Set Rng = Range(Range("J2"), Range("J" & Rows.Count).End(xlUp))
For Each Cell In Rng
If Cell = "Apple" Then
Cell.EntireRow.Delete
End If
Next Cell
End Sub

 

[Rick Rothstein]

No question about it in my mind - I have pirated and used your clever approach shamelessly more than a few times and where there are more than a handful of rows to delete it seems markedly faster. The time saved is time not spent "acquiring" the rows that must be deleted. Specialcells does that very quickly.

What I find annoying about my approach is that it has to be used at all... the Find dialog box has a "Find All" button which can locate all the cells meeting the specified criteria nearly instantly, but the underlying code that does this magic is not available to the programmer forcing us to find kludge alternatives like the method I used.

 

[JoeMo]

What I find annoying about my approach is that it has to be used at all... the Find dialog box has a "Find All" button which can locate all the cells meeting the specified criteria nearly instantly, but the underlying code that does this magic is not available to the programmer forcing us to find kludge alternatives like the method I used.

Agreed, Microsoft doesn't share its really neat tricks, but one man's "kludge" is an other man's treasure - I think your kludge is very creative.

 

[kescco]

This makes sense. That would account for the extra rows that are not deleted.

Thank you for the help.

Kescco

 

[andrewmrichards]

You must delete rows starting from the bottom and For Each starts from the top. When you start from the top, adjacent row that meet your criteria don't all get deleted because once the first one is deleted, the second one moves up to take the place of the deleted one, then the loop iterates to the next row, but that second one is no longer there (because it moved up). Try it this way...QUOTE]


I know this thread is ANCIENT now, but I just came across it in Twitter.

I take exactly what you're saying about loops being inherently slow as a way of doing this sort of thing, but to resolve the issue of removing rows which then cause other rows to shift, this is the approach I tend to take:

Sub DeleteApples()
Dim rngSearch As Range, rngFound As Range
Dim Cell As Range
Set rngSearch = Range("A1").CurrentRegion

For Each Cell In rngSearch.Cells
    If UCase(Cell.Value) = "APPLE" Then
        If Not rngFound Is Nothing Then
            Set rngFound = Union(rngFound, Cell)
        Else
            Set rngFound = Cell
        End If
    End If
Next Cell
 
If Not rngFound Is Nothing Then rngFound.EntireRow.Delete
End Sub

 

[andrewmrichards]

You must delete rows starting from the bottom and For Each starts from the top. When you start from the top, adjacent row that meet your criteria don't all get deleted because once the first one is deleted, the second one moves up to take the place of the deleted one, then the loop iterates to the next row, but that second one is no longer there (because it moved up). Try it this way...

I know this thread is ANCIENT now, but I just came across it in Twitter.

I take exactly what you're saying about loops being inherently slow as a way of doing this sort of thing, but to resolve the issue of removing rows which then cause other rows to shift, this is the approach I tend to take:

Sub DeleteApples()
Dim rngSearch As Range, rngFound As Range
Dim Cell As Range
Set rngSearch = Range("A1").CurrentRegion

For Each Cell In rngSearch.Cells
    If UCase(Cell.Value) = "APPLE" Then
        If Not rngFound Is Nothing Then
            Set rngFound = Union(rngFound, Cell)
        Else
            Set rngFound = Cell
        End If
    End If
Next Cell
 
If Not rngFound Is Nothing Then rngFound.EntireRow.Delete
End Sub

...and looking back on it again to try to remove the slow loop (and in case anyone stumbles upon this thread!) here's another go but looping through an array, rather than a collection of cells, which should be quicker...

Sub DeleteApples_v2()
Dim Search
Dim MatchCells As String
Dim i As Integer
ReDim Search(1 To Range("A1").CurrentRegion.Rows.Count, 2)
Search = Range("A1").CurrentRegion.Value
For i = 1 To UBound(Search, 1)
    If UCase(Search(i, 1)) = "APPLE" Then
        MatchCells = MatchCells & i & ","
    End If
Next i
If Not MatchCells = vbNullString Then
    MatchCells = "A" & Replace(MatchCells, ",", ",A")
    MatchCells = Left(MatchCells, Len(MatchCells) - 2)
    Range(MatchCells).EntireRow.Delete
End If
End Sub