Improvements to Destroy Paragraph VBA Script

Am currently using the script shown to remove paragraphs from a document. However my VBA is not that advanced and I now have 15+ keywords where I need the paragraphs removed (+ paragraph above the occurence). I am basically just repeating the script for each keyword, but this ends up being fairly slow as Word has to iterate through the document up to 15 times.

Is there a way to write the code more efficeintly and just supply say a hard coded comma seperated list of keywords to look for?

Cheers

Phat

Selection.HomeKey unit:=wdStory
 
For Each para In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
    With Selection.Find
       .Text = "NUMBERONFORM"
      .Replacement.Text = ""
     .Forward = True
        '.Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Selection = "NUMBERONFORM" And Selection.Information(wdWithInTable) = False Then
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveLeft
Selection.MoveDown unit:=wdParagraph, Count:=2, Extend:=wdExtend
        Selection.Cut
Selection.MoveDown unit:=wdParagraph, Count:=1
    End If
Next para

Open in new window

phatmankerrAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Guy Hengel [angelIII / a3]Billing EngineerCommented:
please try to start your script with

Application.ScreenUpdating = false

and after the script, put

Application.ScreenUpdating = true

that will make it a "bit" faster.

for the rest, you could, for each paragraph, loop on a "array" of the 15 keywords, and if any matches (ie when you delete), stop looping that array.
0
phatmankerrAuthor Commented:
Angellll,

Thanks for that mate, I didn't include the whole script, I have Screenupdating turned of already.

How do I actually loop on an array ?

And I the keywords may be present in several different paragrpaphs so do I actually want to stop looping the array when there is a match ?

Sorry mate I really am not a VBA expert - cobbled the above together by building a macro and then nicking the code.

Thanks

Phat
0
Guy Hengel [angelIII / a3]Billing EngineerCommented:
let's see if this gives you some input:
Dim arrKeywords(1 to 15) as string
arrKeywords(1) = "NUMBERONFORM"
arrKeywords(2) = "KEYWORD"
'etc, fill in all the keywords...
 
Dim l as long
 
for l = lbound(arrkeywords) to ubound(arrkeywords)
 if arrkeywords(l) <> empty then
   Selection.HomeKey unit:=wdStory
      With Selection.Find
        .Text = arrkeywords(l)
        .Replacement.Text = ""
        .Forward = True
        '.Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
     End With
     while Selection.Find.Execute
       If Selection.Information(wdWithInTable) = False Then
          Selection.MoveUp unit:=wdParagraph, Count:=1
          Selection.MoveLeft
          Selection.MoveDown unit:=wdParagraph, Count:=2, Extend:=wdExtend
          Selection.Cut
       End If
    wend
  end if 'arrkeywords(l) <> empty then
Next l ' loop on  the keywords...

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
phatmankerrAuthor Commented:
Angellll,

Thanks for you help mate - is much appreciated.
0
phatmankerrAuthor Commented:
Angellll, worked perfectly - much tidier and appears to be quicker as well.

Many thanks for youe help !

Phat
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.