?
Solved

Word Macro: Find and select loop to end of document

Posted on 2003-02-26
16
Medium Priority
?
817 Views
Last Modified: 2012-06-21
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
Comment
Question by:BigBee
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
  • 5
16 Comments
 
LVL 2

Expert Comment

by:lvngstn
ID: 8027212
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
 

Author Comment

by:BigBee
ID: 8027460
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
 
LVL 43

Expert Comment

by:Steve Knight
ID: 8029659
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
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 
LVL 2

Expert Comment

by:lvngstn
ID: 8033402
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
 
LVL 2

Expert Comment

by:lvngstn
ID: 8033440
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
 
LVL 2

Expert Comment

by:lvngstn
ID: 8033478
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
 
LVL 2

Expert Comment

by:lvngstn
ID: 8033485
Dah!  Sorry for the double-post.  Its still early...
0
 
LVL 43

Expert Comment

by:Steve Knight
ID: 8033732
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
 

Author Comment

by:BigBee
ID: 8035702
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
 

Author Comment

by:BigBee
ID: 8035966
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
 
LVL 43

Accepted Solution

by:
Steve Knight earned 150 total points
ID: 8037340
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
 

Author Comment

by:BigBee
ID: 8038033
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
 

Author Comment

by:BigBee
ID: 8038052
Thanks, If you find out how to put in the blank line before the bold let me know!

BigBee
0
 
LVL 43

Expert Comment

by:Steve Knight
ID: 8040210
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
 
LVL 43

Expert Comment

by:Steve Knight
ID: 8040229
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
 

Author Comment

by:BigBee
ID: 8043086
Sorry steve. It is my first question. No hard feelings. Thanks for all your help.
0

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question