Find and Loop Macro

[Pat Cortez]

Can't seem to find anything similar on this site but I
need the following code. I want to search for any text
where strikethrough has been applied. I then want to
delete the text and do it again until all strikethrough
text has been deleted. When I did a plain search, I am
left with the space after the phrase so a simple search
did not work. Any help is appreciated!

 

[Peter Hewett]

Hi Pat

This should do the job unless there's something else lurking in your
document:

Sub ReplaceAllStrikethrough()
With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub

HTH + Cheers - Peter

 

[Pat Cortez]

Peter, thanks for your help. I tried it and it does take
out the strikethrough and the text on which the
strikethrough is applied but I am still left with an extra
space after the text is gone. How can I get rid of that
extra space? Thanks in advance.

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Dim myrange As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
Do While .Execute(FindText:="", Wrap:=wdFindContinue, Forward:=True)
= True
Set myrange = Selection.Range
myrange.End = myrange.End + 1
If Right(myrange, 1) = " " Then
myrange.Delete
Else
myrange.Start = myrange.Start - 1
myrange.End = myrange.End - 1
myrange.Delete
End If
Loop
End With


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Pat Cortez]

Thank you, Doug. You're a god.

-----Original Message-----
Dim myrange As Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
Do While .Execute(FindText:="",

Wrap:=wdFindContinue, Forward:=True)