Thank you, my worksheet is many columns wide and +1000 rows. All the macro
work great, didn't realize so many way to accomplish the task. Everyone,
thank you...

Steve

"Dave Peterson" wrote:

If you look at VBA's help for .find, you'll see an example how to loop through
the range. When you find the topmost cell the second time, you know your loop
is finished and you've found all your cells.

But the bad news is that .findnext() doesn't remember the .findformat stuff.

But the good news is that you can just do another find--but after the previous
foundcell--just like your own version of .findnext().

Option Explicit
Sub DeleteStikeouts()

Dim myRng As Range
Dim DelRng As Range
Dim FoundCell As Range
Dim FirstAddress As String
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
Set myRng = .Range("a1:a25")
End With

With Application.FindFormat.Font
.Strikethrough = True
.Superscript = False
.Subscript = False
End With

With myRng
Set FoundCell = .Cells.Find(what:="", _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlPart, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False, _
searchformat:=True)

If FoundCell Is Nothing Then
MsgBox "None found"
Else
FirstAddress = FoundCell.Address
Set DelRng = FoundCell
Do
Set FoundCell = .Cells.Find(what:="", _
after:=FoundCell, _
LookIn:=xlValues, _
lookat:=xlPart, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False, _
searchformat:=True)
If FoundCell.Address = FirstAddress Then
Exit Do
Else
Set DelRng = Union(DelRng, FoundCell)
End If
Loop
If DelRng Is Nothing Then
'this shouldn't happen
Else
DelRng.EntireRow.Select '.Delete 'when you're sure it worked
End If
End If
End With
End Sub


I used .select so you could verify that it was working--change it to .delete
when you're ready to test it out.

Steve wrote:

I need to create a macro that will scan column A for any cells that contains
text with stikeouts and delete that entire row from the worksheet. My poor
example records manual keystokes but does not function.

Sub DeleteStikeouts()
'
Range("A1:A25").Select
With Application.FindFormat.Font
.Strikethrough = True
.Superscript = False
.Subscript = False
End With
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True).Activate
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Range("A3").Select
Cells.FindNext(After:=ActiveCell).Activate
End Sub

Steve

--

Dave Peterson