Results 1 to 11 of 11
  1. #1
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts

    Macro to hightlight key words in document in Word 2010

    Hi, I have created a macro in Word 2010 to highlight certain words in documents that need attention when the document is house styled. My macro is very long-winded and I want to condense some of it.

    Firstly, I need the macro to automatically highlight the words in yellow highlight.

    Secondly, I want to condense Minute, minute, Hour, hour, Day, day, Week, week, Month, month, Year, year, Business, business, Working, working - I want the macro to highlight all instances either in lowercase or initial capital.

    Thirdly I need it to look for words in the singular and words in the plural:
    Clause, Clauses, Paragraph, Paragraphs, Part, Parts, Schedule, Schedules, Section, Sections, Regulation, Regulations, Article, Articles - I only want the macro to highlight words with an initial capital

    Fourthly, I need the macro to highlight instances of ten, twelve, fourteen, eighteen, twenty, thirty, forty written as words not figures basically anything written as words from ten and above - the idea is that when highlighted I can choose whether they need to be converted to figures in line with house style.

    The macro I have created highlights several other words but the above are what I am having trouble with. I can't see where to copy my macro coding on here to show you.

    Many thanks
    Shelley

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    You could use something like:
    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrFnd As String, i As Long
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .MatchCase = False
      .MatchWholeWord = True
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      Options.DefaultHighlightColorIndex = wdYellow
      StrFnd = "Minute,Hour,Day,Week,Month,Year,Business,Working"
      For i = 0 To UBound(Split(StrFnd, ","))
        .Text = Split(StrFnd, ",")(i)
        .Execute Replace:=wdReplaceAll
      Next
      .MatchCase = True
      'Options.DefaultHighlightColorIndex = wdBrightGreen
      StrFnd = "Clause,Paragraph,Part,Schedule,Section,Regulation,Article"
      For i = 0 To UBound(Split(StrFnd, ","))
        .Text = Split(StrFnd, ",")(i)
        .Execute Replace:=wdReplaceAll
        .Text = Split(StrFnd, ",")(i) & "s"
        .Execute Replace:=wdReplaceAll
      Next
      .MatchCase = False
      'Options.DefaultHighlightColorIndex = wdTurquoise
      StrFnd = "ten,twelve,fourteen,eighteen,twenty,thirty,forty"
      For i = 0 To UBound(Split(StrFnd, ","))
        .Text = Split(StrFnd, ",")(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    Application.ScreenUpdating = True
    End Sub
    note that I've included some commented-out code for changing the highlights
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    Star Lounger Graham Mayor's Avatar
    Join Date
    Mar 2016
    Location
    Cyprus
    Posts
    68
    Thanks
    0
    Thanked 24 Times in 24 Posts
    Create a two column table with the words you want to find in Column 1 and True of False in column 2 according to whether you want to check the case or not and save it as a document e.g. C:\Path\Changes.docx (see attached) then run the following macro:
    Code:
    Sub ReplaceFromTableList()
    Dim oChanges As Document, oDoc As Document
    Dim oTable As Table
    Dim oRng As Range
    Dim rFindText As Range, rReplacement As Range
    Dim i As Long
    Dim sFname As String
    Dim sAsk As String
        sFname = "C:\Path\Changes.docx" ' The path to the table
        Set oDoc = ActiveDocument
        Set oChanges = Documents.Open(Filename:=sFname, Visible:=False)
        Set oTable = oChanges.Tables(1)
        For i = 1 To oTable.Rows.Count
            Set oRng = oDoc.Range
            Set rFindText = oTable.Cell(i, 1).Range
            rFindText.End = rFindText.End - 1
            Set rReplacement = oTable.Cell(i, 2).Range
            rReplacement.End = rReplacement.End - 1
            With oRng.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                Do While .Execute(FindText:=rFindText, _
                                  MatchWholeWord:=True, _
                                  MatchCase:=CBool(rReplacement), _
                                  Forward:=True, _
                                  Wrap:=wdFindStop) = True
                    oRng.HighlightColorIndex = wdYellow
                    oRng.Collapse wdCollapseEnd
                Loop
            End With
        Next i
        oChanges.Close wdDoNotSaveChanges
    lbl_Exit:
        Exit Sub
    End Sub
    To post code, click Go Advanced and use the Code Tags to surround your pasted code.
    Attached Files Attached Files

  4. #4
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts

    Macro to highlight key words in document in Word 2010

    Hi Macropod, thank you so much for your coding it works brilliantly. I have now added some other words to the Clause, Paragraph etc. bit that I need to find in initial capital which has reduced the rest of my coding considerably. The following code is what else I need to add to the highlight coding. It needs to search for every digit in a document, plus lowercase words per cent, chapter, uppercase word PROVIDED, quote marks and square brackets. Is there an easy way of adding my coding to your coding or can it be simplified even further.

    I also highlight instances of a.m. or a.m which represent times in our documents that need to convert to 'am' without the full stops. I have a separate format clean up doc macro but for some reason I cannot get 'a.m.' to convert to 'am' correctly, it works perfectly for p.m. but not a.m.

    I hope I've inserted my coding the correct way for you. Many thanks Shelley

    Code:
    Sub DPU_HighlightDigitsQuotesDates()
    '
    ' DPU_HighlightDigitsQuotesDates Macro
    '
    '
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = True
        With Selection.Find
            .Text = "^#"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = """"
            .Replacement.Text = """"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "chapter"
            .Replacement.Text = "chapter"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "["
            .Replacement.Text = "["
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "]"
            .Replacement.Text = "]"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "a.m."
            .Replacement.Text = "a.m."
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "a.m"
            .Replacement.Text = "a.m"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Replacement.Highlight = True
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "PROVIDED"
            .Replacement.Text = "PROVIDED"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
       Selection.Find.Execute Replace:=wdReplaceAll
    End Sub

  5. #5
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Many thanks Graham for your reply, regards Shelley

  6. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    You could add:
    ,per cent,chapter,PROVIDED
    after:
    Regulation,Article
    and insert:
    Code:
      'Options.DefaultHighlightColorIndex = wdPink
      .MatchWildcards = True
      .Text = "[0-9\[\]]{1,}"
      .Replacement.Text = "^&"
      .Execute Replace:=wdReplaceAll
      .Text = "<[ap].[m.]{1,2}"
      .Execute Replace:=wdReplaceAll
    before:
    End With
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. #7
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Hi Macropod, thanks for the coding, I've now added this and it works great. In the .Text = "[0-9\ [\] ]{1,}" can I add to highlight quotes, would this be "[0-9\ [\]\ "\" ] {1, }".

    Thanks, Shelley

  8. #8
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    When using wildcards for quotes, you'd need to specify the smart quotes as well as straight quotes if you want all three highlighted. For example:
    .Text = "[0-9\[\]^34^147^148]{1,}"
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  9. #9
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    I've copied this over and it only highlights straight quotes, everything else works great though so many thanks for your help. Regards, Shelley

  10. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Ok, try:
    .Text = "[0-9\[\]^34^0147^0148]{1,}"
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  11. The Following User Says Thank You to macropod For This Useful Post:

    Lady-Laughsalot (2016-03-19)

  12. #11
    Star Lounger
    Join Date
    Aug 2015
    Posts
    98
    Thanks
    14
    Thanked 0 Times in 0 Posts
    Fantastic, yes that works perfectly, much appreciated, regards Shelley

Posting Permissions

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