Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 197
  • Last Modified:

VBA Maco for MS Word, page # problem, Please Help?

I need to develop a macro that will loop through a document and find and format each word "folder". Any ideas? I tryed counting the lines and looping through the count but it seems to lock up. I have over 500 pages of text. Word runs through the count loop slower and slower as the # of lines in the document increase. Lines 1 - 100 take 3 sec, ;but lines 4000 - 4100 take 15 sec, and by the 9000 line this takes forever and never finishes. Here is what I am starting with.

Sub Macro1()
Dim strFind As String
   strFind = "Folder"      'case is not important
   Application.ScreenUpdating = False
   Dim currentSentence As Word.Range
   Dim counter As Integer
   counter = 1
   'number of sentences in the document
   Dim sentenceCount As Integer

   With ActiveDocument
       sentenceCount = .Sentences.Count
       If sentenceCount = 0 Then Exit Sub
   End With
   'loop through all sentences
   For counter = 1 To sentenceCount
       'do one sentence at a time
       Set currentSentence = ActiveDocument.Sentences(counter)
       With currentSentence.Find
           'check sentence for the target word
           If .Execute(FindText:=strFind) Then
             ' target word was found; bold the entire current sentence
               ActiveDocument.Sentences(counter).Font.Bold = True
           End If
       End With
   Next counter
End Sub
  • 2
1 Solution
I'm not sure if this will help, but try adding the following before "next counter":

  set currentSentence = Nothing

My thinking is that each time you set currentSentence, Word may not be releasing the memory correctly.  
Steve KnightIT ConsultancyCommented:
Perhaps I'll get an A grade in this copy of the question?

Sub FindReplace()

With Selection.Find
   .MatchCase = False
   .MatchWholeWord = True
   Do While .Execute(FindText:="Folder") = True
       Selection.HomeKey Unit:=wdLine
       Selection.EndKey Unit:=wdLine, Extend:=wdExtend
       Selection.Font.Bold = True
       Selection.InsertBefore (vbCrLf)
       Selection.MoveDown (wdLine)
       Selection.MoveStart (wdLine)
       Selection.MoveEnd (wdStory)
End With

BigBeeAuthor Commented:
Ok you got it. LOL...
Steve KnightIT ConsultancyCommented:
OK cheers, bit cheeky but what the hell :-)


Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now