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

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 824
  • Last Modified:

Word Macro: Find and select loop to end of document

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.

Sub Macro1()
Dim strFind As String
   
    strFind = "Folder"      'case is not important
 

    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
                ActiveDocument.Sentences(counter).InsertParagraphBefore
                               
            End If
       
        End With
       
    Next counter
End Sub
0
BigBee
Asked:
BigBee
  • 6
  • 5
  • 5
1 Solution
 
lvngstnCommented:
I don't really know my way around VBA|Word, but this seems to work for me.  Give it a run and see how it handles.

Sub FormatFolders()

Dim strFind As String
Dim Wrd As Range

strFind = "Folder"

Application.ScreenUpdating = False

For Each Wrd In ThisDocument.Range.Words
   With Wrd
      If .Text = strFind And .Font.Bold = False Then
         .Font.Bold = True
         .InsertParagraphBefore
      End If
   End With
Next Wrd

End Sub


lvngstn
0
 
BigBeeAuthor Commented:
lvngstn

That doesn't seem to work. The word "Folder" always appears as the first word on the line. I will try to work with what you gave me and get back to you. Maybe there are some other suggestions out there.

BigBee
0
 
Steve KnightIT ConsultancyCommented:
May be a silly question but is there any reason you can't use the built in search & replace for this?

Edit | Replace
Find What: Folder
Replace with: Folder
More
Format | Font | Bold or whatever....

which recorded as a macro and tidied up a bit would give:

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
 With Selection.Find.Replacement.Font
     .Bold = True
     .Shadow = True
 End With
 With Selection.Find
     .Text = "Folder"
     .Replacement.Text = "Folder"
     .Forward = True
     .Wrap = wdFindContinue
     .Format = True
     .MatchCase = False
     .MatchWholeWord = True
    End With
 Selection.Find.Execute Replace:=wdReplaceAll

Steve
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
lvngstnCommented:
What that doesn't do is find instances of "Folder" that are tucked inside of other strings (i.e. "FolderFolderFolder" will not result in three seperate finds).  I've actually been playing around with that too, Steve.  
0
 
lvngstnCommented:
Oh!  Breakthrough!  

Just found the .MatchWholeWord property and added the needed carriage return to the .Replacement.Text:

Sub ReplaceFolder()

With Selection.Find
    .ClearFormatting
    .Text = "Folder"
    .Replacement.ClearFormatting
    .Replacement.Font.Bold = True
    .Replacement.Text = vbCR & "Folder"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .Execute Replace:=wdReplaceAll
End With

End Sub

Give it a go, BigBee.

lvngstn
0
 
lvngstnCommented:
Oh!  Breakthrough!  Found the .MatchWholeWord propery and added the necessary carriage return to .Replacement.Text (and general clean up of the macro recorder):

Sub ReplaceFolder()

With Selection.Find
    .ClearFormatting
    .Text = "Folder"
    .Replacement.ClearFormatting
    .Replacement.Font.Bold = True
    .Replacement.Text = vbCr & "Folder"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .Execute replace:=wdReplaceAll
End With

End Sub

Give it a go, BigBee.

lvngstn
0
 
lvngstnCommented:
Dah!  Sorry for the double-post.  Its still early...
0
 
Steve KnightIT ConsultancyCommented:
I had changed the default FALSE for .MatchWholeWord to TRUE because I assumed only whole words were probably wanted ... could be either I suppose!

Steve
0
 
BigBeeAuthor Commented:
There is one problem still. I need to highlight the whole line that starts with the word folder. FolderFolder or things like that will not exist in the text. The selection thing will work, however it still needs to be done without replace all.

This way I can go

Find Folder, expand selection to key.end, selection.font = bold

What I really need is a way to loop through the find next and have it stop at the end of the document.

Your Help is appreciated!

BigBee
0
 
BigBeeAuthor Commented:
Hi again, my first macro works, but for a 500 page document it takes forever... ie doesn't ever finish. I have just figured out that word seems to take longer to complete the per line task the further into the document it gets. Any ideas why this might happen, or how I could get around it.
0
 
Steve KnightIT ConsultancyCommented:
OK, try this:

hth

Steve

Sub FindReplace()

ActiveDocument.Select
With Selection.Find
    .ClearFormatting
    .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.MoveStart (wdLine)
        Selection.MoveEnd (wdStory)
    Loop
End With

End Sub
0
 
BigBeeAuthor Commented:
ok steve, This works. I just need to figure out how to insert a blank line before each findtext = true. I have tried to use insertParagraphBefore but it doesn't seem to work. I give you credit for the answer though.

BigBee
0
 
BigBeeAuthor Commented:
Thanks, If you find out how to put in the blank line before the bold let me know!

BigBee
0
 
Steve KnightIT ConsultancyCommented:
Well thankyou.  I don't appreciate a B grade for a working solution to a problem.  I hadn't noticed the requirement for a new line because it isn't described anywhere -- though I see you do have such a line in yuor code I don't have time to read and debug every line of someone else's code to work out what a problem is.

Entering a blank line should be a case of adding:

Selection.InsertBefore (vbCrLf)
Selection.MoveDown (wdLine)

after the font change.

There may be neater was (I am more into XL...) but as you say, it works, and presumably relatively fast compared with looping through all the words?

Steve
0
 
Steve KnightIT ConsultancyCommented:
Hadn't realised this was your first question BigBee. FYI you basically have these options with any question on EE, the link at the bottom explains the grading schemes a little.

1. If you are happy with the answer by choosing "accept answer" against one of the comments (as you did) remembering the normal grade is an "A".

2. If you didn't get any suitable help post a 0 point question in the Community Support area asking them to delete the question

3. Post a 0 point question in the same place if you wish to split points between different people or anything else that you can't amend yourself.

"How do I know what grade to give?":
http://www.experts-exchange.com/jsp/cmtyQuestAnswer.jsp#3

0
 
BigBeeAuthor Commented:
Sorry steve. It is my first question. No hard feelings. Thanks for all your help.
0

Featured Post

Industry Leaders: 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!

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