Solved: ‘Find’ and ‘Find Next’ delete StrikeThrough

[Dave T]

Hello All,

At work I use a macro to apply strikethrough to selected/highlighted text to show text that is to be deleted and use another macro that underlines text that is to be added.

When highlighted text additions/deletions have been approved I have previously manually selected each word/words with strikethrough and deleted them.

I am after a macro that operates in the same way as the ‘Find’ and ‘Replace’ dialogue in word.

I found a macro by Greg Maxey that does the whole document in one go (http://www.officekb.com/Uwe/Forum.aspx/word-vba/23185/Macro-to-find-and-delete-strikethrough), but it only deleted the strikethrough text and left extra spaces.
Then I found another macro by Doug Robbins (http://hewreck.com/qanda/replies/find-and-loop-macro-1121577) which does the same as Greg’s but does not leave spaces.


Sub DeleteStrikethroughTextV2()
'http://hewreck.com/qanda/replies/find-and-loop-macro-1121577
'Doug Robbins

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
End Sub

This macro works exactly as I am looking for but it does the whole document in one action and does not give you time to see what is going to be deleted.

I am seeking help to modify Doug’s code so that a vbYesNoCancel message box can be used to step through the document so I can see each word or range of words with strikethrough and decide whether or not to delete them.

Any help would be appreciated.

PS Forgot to mention I am using Word 2003

Regards,
Dave T

[gmaxey]

Sub DeleteStrikethroughTextV2()
Dim myRange As Range
Set myRange = ActiveDocument.Range
With myRange.Find
.ClearFormatting
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
Do While .Execute(findText:="", Wrap:=wdFindContinue, Forward:=True) = True
myRange.Select
ActiveWindow.ScrollIntoView Selection.Range
If MsgBox("Do you to delete?", vbQuestion + vbYesNo, "Delete") = vbYes Then
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
myRange.Collapse wdCollapseEnd
End If
Loop
End With
End Sub

[Dave T]

Hello Greg,

Thanks for the reply, but I seem to be having problems with your solution.

If I click 'Yes' it works perfectly;
If I click 'No' it goes to the next instance of strikethrough which is what I expected; but is caught in an endless loop i.e. when it reaches the last occurence of strikethrough then it starts back at the beginning of the document and runs through again and again. The only way to escape the message box is to select 'Yes' and the message box finally closes when all the strikethrough has been deleted;
I have been trying to add a vbCancel button so the macro can be cancelled without the need to go from the start to the end of the document.I really do appreciate your prompt reply.

Regards,
Dave T

[gmaxey]

Free solutions are rarely fully tested. Sorry about that.

Sub DeleteStrikethroughTextV2()
Dim myRange As Range
Set myRange = ActiveDocument.Range
With myRange.Find
With .Font
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
Do While .Execute
.Text = ""
.Wrap = wdFindStop
.Forward = True
myRange.Select
ActiveWindow.ScrollIntoView Selection.Range
Select Case MsgBox("Do you want to delete this instance?", vbQuestion + vbYesNoCancel, "Delete")
Case vbYes
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
Case vbNo
myRange.Collapse wdCollapseEnd
Case Else
GoTo lbl_Exit
End Select
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[Dave T]

Hello Greg,

I really do appreciate the effort you put in replying to various posts.
They are always good to look at and learn from.
Thank you very much for your time in providing this solution.

Regards, Dave T

[gmaxey]

You're welcome.