The macro deletes all

S

Steved

Hello from Steved

I've through the lack of knowledge the workings of a macro
have put together the below macro. It does exactly As I
require but when it reaches the end of a document it
starts to delete everything from the bottom of the
document to the top off the document until everything is
deleted.

Question please How do I ask the macro to end at the
bottom of the document. I changed .Wrap = wdFindContinue
to .Wrap = wdFindStopas I thought this was the problem,
can someone please help.
Thankyou.


Sub RaceDictionary()
Dim i As Long, pararange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "'"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<[A-Za-z]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "("
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\(*by"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="= "
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeText Text:=", "
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "prz"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 30
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Next i
End Sub
 
J

Jezebel

Steved, if you're not prepared to put in the effort to learn something about
coding, it's a bit rude to expect other people to put in the effort to fix
your application. You've been asking essentially the same question for two
weeks now, and it's been answered any number of times. You've been given
more than enough information to solve the problem.




Steved said:
Hello from Steved

I've through the lack of knowledge the workings of a macro
have put together the below macro. It does exactly As I
require but when it reaches the end of a document it
starts to delete everything from the bottom of the
document to the top off the document until everything is
deleted.

Question please How do I ask the macro to end at the
bottom of the document. I changed .Wrap = wdFindContinue
to .Wrap = wdFindStopas I thought this was the problem,
can someone please help.
Thankyou.


Sub RaceDictionary()
Dim i As Long, pararange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "'"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<[A-Za-z]@>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.HomeKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "("
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\(*by"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="= "
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeText Text:=", "
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "prz"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 30
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Next i
End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Loop until end 1
Select Text to End of Footnote 9
Word macro that can call cells out of Excel for a find and replace 0
Bug 12
CleanUpPastedText() 1
Find/Replace macro only limited to selection when entire paragraphis selected 22
What is needed to function probaly 2

Top