How do I search a doc and run code on finding a word?

Helend269 · #1 08-29-2017, 05:35 PM

How would I write a search that goes all through a Word doc and if a particular word is found, say "Example", then a block of code is run once before the search goes on to find the next instance of that word?

I know it must be simple but I can't seem to work it out. Thank you.

macropod · #2 08-29-2017, 08:49 PM

You could use something along the lines of:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    With .Duplicate
      .Collapse wdCollapseStart
      .Text = "Prefix "
      .Font.Italic = True
    End With
    With .Duplicate
      .Collapse wdCollapseEnd
      .Text = " Suffix"
      .Font.Bold = True
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

This code simply adds an italicized 'Prefix' & 'Suffix' to each found instance; you could replace those with whatever other code you want, including calls to functions/macros.

Helend269 · #3 08-29-2017, 09:23 PM

Thanks but I can't quite get it to work as I want it to. Perhaps I'd better explain what I want to do. I have something like this:

Random line that stays as it is.
TRIGGER LINE
This text to be made uppercase
Random line that stays as it is.
Random line that stays as it is.
Random line that stays as it is.
TRIGGER LINE
This text to be made uppercase
Random line that stays as it is.
Random line that stays as it is.
Random line that stays as it is.

I have a small bit of code from recording a macro that goes down one line from the TRIGGER LINE, selects the line where the cursor now is and makes it uppercase.

The problem is I have 3,000-odd instances of the TRIGGER LINE so I need to automate it.

The code I have to do this is:

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.AllCaps = True
Selection.HomeKey Unit:=wdLine

I just need to be able to have something that searches for each instance of the text TRIGGER LINE and then runs my code. It would then move on to the next instance of TRIGGER LINE and repeat until the end of the document.

When I tried to put my code in your code it uppercased everything. It wasn't clear to me which part sof your code were interchangeable.

macropod · #4 08-29-2017, 09:32 PM

It looks like you need:

Code:

  Do While .Find.Found
    .Paragraphs.Last.Next.Range.Font.AllCaps = True
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop

Helend269 · #5 08-29-2017, 09:59 PM

Thank you, that worked beautifully on a test piece but on the target document it made it non-responding, threw up an error after a minute or two and ALL the text was in caps. Clearly a problem with the size of the document, not your code so thank you for answering my query but I seem to be asking it to do too much on a huge document. (4,000 pages, 1/2 million words or so!)

However, since it works on a smaller document I can still use it. I'll just copy chunks of text to a new document, run this macro over that and then re-paste the altered text back into the huge document. That should work. :-)

Many thanks for your help, it is much appreciated.

macropod · #6 08-29-2017, 10:11 PM

The only paragraphs that would be affected are those following a paragraph containing your 'trigger' text. Obviously, if you have multiple consecutive paragraphs containing that text, they'd all be capitalised.

For a large document with many items to process, it's beneficial to yield time to the operating system periodically. Accordingly, try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    If i Mod 100 = 0 Then DoEvents
    .Paragraphs.Last.Next.Range.Font.AllCaps = True
    .Start = .Paragraphs.Last.Range.End
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

With this version, the OS gets some breathing space after every 100 updates. The revised code also avoids re-processing a paragraph if your 'trigger' occurs in it multiple times, which will improve efficiency in such cases.

Helend269 · #7 08-29-2017, 10:23 PM

That's fixed it. Thank you! :-)

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Outlook search not finding recent mail; rebuild ix did nothing	PeterA	Outlook	0	01-19-2017 12:27 AM
Need some vba code to search a word document an replace it if len = 3	Belleke	Word VBA	3	10-24-2016 01:00 AM
Finding more than one word using "find" or using a vba code	capitala	Word VBA	1	02-03-2014 06:45 PM
Outlook 2010 Search not finding all items	gdrunner	Outlook	2	03-10-2013 06:48 PM
Outlook 2010 search not finding everything	rexracer	Outlook	5	07-21-2011 02:31 AM