Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 39 of 39

Thread: vba script find and highlight multi-word phrases

  1. #21
    After having spent some time, it's clear that I'm not yet apt to resolve the problem. So, I devised a simple ("lame") workaround that still helps:
    ::Please don't laugh::

    [VBA]Sub ScratchMacro()
    Dim oRng As Word.Range
    Dim arrWords
    Dim i As Long
    arrWords = Array("I think that", "very")
    For i = 0 To UBound(arrWords)
    Set oRng = ActiveDocument.Range
    With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = arrWords(i)
    .MatchWholeWord = True
    .Replacement.Highlight = True
    .Execute Replace:=wdReplaceAll
    End With
    Next

    arrWords = Array("the", "list", "of", "words", "to", "exclude")
    For i = 0 To UBound(arrWords)
    Set oRng = ActiveDocument.Range
    With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = arrWords(i)
    .MatchWholeWord = False
    .Replacement.Highlight = False
    .Execute Replace:=wdReplaceAll
    End With
    Next

    End Sub [/VBA]Only thing's that the highlight color stays uniform throughout.

  2. #22
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Hi HJ,

    The fundamental issue is that you haven't told Word what to do with the found text. Aside from that, you code invests a lot of effort redifining things that only need to be defined once. Try it this way:
    Sub Demo()
    Dim oRng As Range, arrWords, i As Long
    'Lines with an asterisk need to be defined only once
    Set oRng = ActiveDocument.Range '*
    With oRng.Find '*
      arrWords = Array("I think that", "very")
      .ClearFormatting '*
      .Replacement.ClearFormatting '*
      .MatchWholeWord = True '*
      .Replacement.Text = "^&" '*
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      arrWords = Array("the", "list", "of", "words", "to", "exclude")
      .Replacement.Highlight = False
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    End Sub
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #23
    Hi macropod, your kindness while killing me is also very invigorating.
    I changed the [VBA] .MatchWholeWord = True[/VBA]to[VBA] .MatchWholeWord = False[/VBA]and get the desired result. Now I oughta see if I can make the two arrayed words "I think that" & "very" highlighted in different colours.
    Thanks once again.

  4. #24
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Hi HJ,

    AFAIK, you can't change the highlight colour within a straightforward Find/Replace, since the highlight colour index isn't a replacement parameter. However, if you define a character style with the desired background shading, you can apply that as a replacement criterion. Even that has its drawbacks, though, as it'll mess with any other character styles applying to the found text.

    If you want to persevere with changing the highlight colour, you'll need a Do While loop that sets that parameter for each found range. I could show you how to do that, but I thought I'd leave it for you as a challenge ...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #25
    VBAX Wizard
    Joined
    May 2004
    Posts
    6,713
    Location
    "you'll need a Do While loop that sets that parameter for each found range. I could show you how to do that, but I thought I'd leave it for you as a challenge ..."

    Ok then, I will stay out of it. A good challenge, but not that difficult.

  6. #26
    Following the last Next I inserted:[VBA] arrWords = Array("very")
    .Replacement.Highlight = True
    .Replacement.Font.Color = wdColorLightBlue
    For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    .Execute Replace:=wdReplaceAll
    Next
    [/VBA]The result's apparent: the font colour changed to light blue, NOT touching the highlight colour. Not quite, but very close to what I'm seeking. Still a very inefficient way, I'm sure; yet the best I can think of for now. Thanks again!

  7. #27
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Hi HJ,

    Try something along these lines:
    Sub Demo()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
      arrWords = Array("very", "high")
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = False
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      HiLite = Options.DefaultHighlightColorIndex
      Options.DefaultHighlightColorIndex = wdYellow
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = HiLite
      arrWords = Array("the", "list", "of", "words", "to", "exclude")
      .Replacement.Highlight = False
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      arrWords = Array("I think that")
      .Replacement.Highlight = True
      HiLite = Options.DefaultHighlightColorIndex
      Options.DefaultHighlightColorIndex = wdBrightGreen
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = HiLite
    End With
    Set oRng = Nothing
    End Sub
    Note: Contrary to my previous advice, the above approach obviates the need to set up a loop for pocessing the green highlights by selection the found ranges. You'll also see how, in this iteration of the code, I've captured and restored the previous highlighting attaributes.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  8. #28
    I was trying to figure out how to exclude words in a Do While loop. But, gosh! This addresses the problem very well I'd better concentrate on some other things now. You're just wonderful, macropod. Thank you so so much!

  9. #29
    Quote Originally Posted by macropod
    Hi HJ,

    Try something along these lines:
    Sub Demo()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
      arrWords = Array("very", "high")
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = False
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      HiLite = Options.DefaultHighlightColorIndex
      Options.DefaultHighlightColorIndex = wdYellow
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = HiLite
      arrWords = Array("the", "list", "of", "words", "to", "exclude")
      .Replacement.Highlight = False
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      arrWords = Array("I think that")
      .Replacement.Highlight = True
      HiLite = Options.DefaultHighlightColorIndex
      Options.DefaultHighlightColorIndex = wdBrightGreen
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = HiLite
    End With
    Set oRng = Nothing
    End Sub
    Note: Contrary to my previous advice, the above approach obviates the need to set up a loop for pocessing the green highlights by selection the found ranges. You'll also see how, in this iteration of the code, I've captured and restored the previous highlighting attaributes.

    Good morning,

    apologies for dragging up this useful thread

    Can someone help me with a quick query?

    With regards to the code above, is it - and if so can someone show me - possible to display a message if one of the words listed in the array is found? Ie if "turkey" was listed and found by the macro it would display the message "You Have Entered a Restricted Word"

    Many thanks, very useful site.

  10. #30
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Try:

    [VBA]Sub DemoX()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
    arrWords = Array("turkey", "vulture")
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = False
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    HiLite = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdYellow
    For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    While .Execute(Replace:=wdReplaceOne)
    oRng.Collapse wdCollapseEnd
    MsgBox "You have used a restricted word: " & arrWords(i)
    Wend
    Next
    End With
    Set oRng = Nothing
    End Sub

    [/VBA]
    Greg

    Visit my website: http://gregmaxey.com

  11. #31
    Doesn't seem to work; however I will put this in the context of me being a total vba noob.

    Here's what I've got, note I've altered the macro to run automatically when the document is saved, in case that makes a difference.

    [vba]Sub FileSave()
    '
    'Sub Demo()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
    arrWords = Array("turkey", "vulture",)
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = False
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    HiLite = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdYellow
    For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    .Execute Replace:=wdReplaceAll
    Next
    Options.DefaultHighlightColorIndex = HiLite
    arrWords = Array("the", "list", "of", "words", "to", "exclude")
    .Replacement.Highlight = False
    For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    While .Execute(Replace:=wdReplaceOne)
    oRng.Collapse wdCollapseEnd
    MsgBox "You have used a restricted word: " & arrWords(i)
    Wend
    Next
    Options.DefaultHighlightColorIndex = HiLite
    End With
    Set oRng = Nothing
    ActiveDocument.Save
    End Sub

    [/vba]

  12. #32
    wait, it's just kicked into life? Thanks!

    Only slight issue is it says "You have used a restricted word: of"

  13. #33
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by TheMongoose
    wait, it's just kicked into life? Thanks!

    Only slight issue is it says "You have used a restricted word: of"
    What would you have it say? The word 'of' is one of the words in the lookup array.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  14. #34
    Oh yes, oops. Told you I was a noob!

    Thanks for the help.

    edit; Greg I've just realised I've used your own site before as well, very helpful too. Thanks again

    One more question; would it be possible to list multiple instances of the words used? It currently says "You have used a restricted word: last word used" , could it be altered to "You have used a restricted word: X, X, X," ?
    Last edited by TheMongoose; 08-21-2012 at 04:36 AM.

  15. #35
    VBAX Newbie
    Joined
    Jan 2013
    Posts
    3
    Location
    Hi

    Further apologies for bring up an old thread but its so useful, I only have one question/request.


    Instead of having
    arrWords = Array("the", "list", "of", "words", "to", "exclude")

    Is it possible foe the Array to reference a csv file or a simple list in a text file or indeed a word document?

    The reason being is I have a 30 page business review document which I must review each week and look for names of our retail units and then highlight these and send on to the field team with the sites highlighted. The issues with writing out a long Array string is the list of sites does change from time to time and a long list is much easier to maintain than editing the script.

    Thanks in advance and A great forum by the way, used many times but my uestions are normally answered without needing more help so have never signed up.

  16. #36
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    See, for example: http://www.vbaexpress.com/forum/show...ulkFindReplace. In that thread, an Excel workbook is used to hold the F/R data.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  17. #37
    Gmaxey,
    I am having trouble tracing the code you provided. I added a few terms to the array and have been stepping through the macro. It seems that when the first term is found and all of the instances of it have been replaced, the range is not redefined to include the entire document when looking for the next term. If the next term is not between where the range was collapsed and the end of the document, none of the remaining terms are found. How do you redefine the range to include the entire document again? All of the attempts I made in doing so caused an infinite loop. Please see my comments in the code below.

    [VBA]Sub DemoX()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant
    Set oRng = ActiveDocument.Range
    With oRng.Find
    arrWords = Array("turkey", "and", "vulture", "pay", "an")
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = False
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    HiLite = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdYellow
    For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    'Resetting the range below causeses an infinite loop
    'Set oRng = ActiveDocument.Range
    While .Execute(Replace:=wdReplaceOne)
    oRng.Collapse wdCollapseEnd
    MsgBox "You have used a restricted word: " & arrWords(i)
    Wend
    'Resetting the range below causeses an infinite loop here too. Setting a
    ' breakpoint here shows this line is never executed, yet an infinite loop
    ' still results. How does this happen?
    'Set oRng = ActiveDocument.Range
    Next
    End With

    Set oRng = Nothing
    End Sub

    [/VBA]

  18. #38
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Try:

    [VBA]Sub DemoXYZ()
    Dim oRng As Range, arrWords, i As Long, HiLite As Variant

    arrWords = Array("vulture", "turkey")
    For i = 0 To UBound(arrWords)
    Set oRng = ActiveDocument.Range
    With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = False
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    HiLite = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdGreen
    .Text = arrWords(i)
    While .Execute(Replace:=wdReplaceOne)
    oRng.Collapse wdCollapseEnd
    MsgBox "You have used a restricted word: " & arrWords(i)
    Wend
    End With
    Next
    Set oRng = Nothing
    End Sub[/VBA]
    Greg

    Visit my website: http://gregmaxey.com

  19. #39
    Thank you Greg, now it works perfect. Looks like I was resetting the range object to the entire document from within the .find block, so of course the macro would be in an infinite loop. Understood now.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •