Search column for specific value, then delete rows found, leaving the first instance

[HTSCF Fareha]

I'm looking to search for the phrase "Helper File" in column A, then delete all rows found containing the phrase, leaving the topmost one intact. The contents of the worksheet should then move up to fill the space left by any deleted row(s).

I've been looking at two different pieces of code that I think might help, but am unsure if this might be the case or how to adapt either to suit my requirements.

Thanks!
Steve


Sub_Tidy()

Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
With Range("A:A")
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = Range("A:A").Find(what:="Helper File", After:=LastCell)

If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
Debug.Print FoundCell.Address
Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop

Exit Sub

End Sub


Sub_Tidy2()

Dim a As Range

Do
Set a = Columns(1).Find(what:="Helper File", LookIn:=xlValues, LookAt:=xlPart)
If a Is Nothing Then Exit Do
a.EntireRow.Delete
Loop

Exit Sub

End Sub

[p45cal]

Are you deleting the whole row of the sheet each time?
If so try:

Sub Tidy()
Dim FoundCell As Range, rowstodelete As Range, LastCell As Range
Dim FirstAddr As String

With Range("A:A")
Set LastCell = .Cells(.Cells.Count)
Set FoundCell = .Find(what:="Helper File", LookIn:=xlFormulas, lookat:=xlWhole, After:=LastCell, searchdirection:=xlNext, searchformat:=False)

If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
Do
Set FoundCell = Range("A:A").Find(what:="Helper File", LookIn:=xlFormulas, lookat:=xlWhole, After:=FoundCell, searchdirection:=xlNext, searchformat:=False)
If Not FoundCell Is Nothing And FoundCell.Address <> FirstAddr Then
If rowstodelete Is Nothing Then Set rowstodelete = FoundCell Else Set rowstodelete = Union(rowstodelete, FoundCell)
End If
Loop Until FoundCell Is Nothing Or FoundCell.Address = FirstAddr
If Not rowstodelete Is Nothing Then rowstodelete.EntireRow.Delete
End If
End With
End Sub

[HTSCF Fareha]

This is just the ticket! Many thanks indeed, p45cal!

Pushing its capabilities one step further, is it possible to perform the same search / delete action on more than one phrase at a time?

Steve

[snb]

Multiple searching = filtering.

[p45cal]

Using this method, only by putting it into a loop:
Sub Tidy()
Dim FoundCell As Range, rowstodelete As Range, LastCell As Range
Dim FirstAddr As String, Phrases, Phrase
Phrases = Array("Helper file", "E", "C", "B", "A")
With Range("A:A")
For Each Phrase In Phrases
Set rowstodelete = Nothing
Set LastCell = .Cells(.Cells.Count)
Set FoundCell = .Find(what:=Phrase, LookIn:=xlFormulas, lookat:=xlWhole, After:=LastCell, searchdirection:=xlNext, searchformat:=False)

If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
Do
Set FoundCell = Range("A:A").Find(what:=Phrase, LookIn:=xlFormulas, lookat:=xlWhole, After:=FoundCell, searchdirection:=xlNext, searchformat:=False)
If Not FoundCell Is Nothing And FoundCell.Address <> FirstAddr Then
If rowstodelete Is Nothing Then Set rowstodelete = FoundCell Else Set rowstodelete = Union(rowstodelete, FoundCell)
End If
Loop Until FoundCell Is Nothing Or FoundCell.Address = FirstAddr
If Not rowstodelete Is Nothing Then rowstodelete.EntireRow.Delete
End If
Next Phrase
End With
End Sub

[HTSCF Fareha]

Brilliant! Many thanks, p45cal.

I wasn't sure if an array could be used, but this has answered this point.

Thanks again!
Steve

[snb]

Sub M_snb()
for each it in Array("Helper file", "E", "C", "B", "A")
With usedrange.columns(1)
with .offset(.find(it).row + 1)
.autofilter 1, it
.offset(1).specialcells(12).entirerow.delete
.autofilter
end with
end with
Next
End Sub