work macro auto highlight words from exle file
Sub VagueWords() ' Source: Paul Edstein (Macropod), 8 Aug 2015: https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-search-and-replace-multiple-wordsletters-in/af4753a0-7afd-433b-910d-a148da66f2bf ' Original macro name: MultiReplace ' Adapted by Rhonda Bracey, Cybertext Consulting, 22 Feb 2020 ' You could duplicate this macro with a different name (e.g. LegalWords [for must, shall, etc.]) using a different list of words in the StrFind and StrRepl lists Dim StrFind As String Dim StrRepl As String Dim i As Long ' In StrFind and StrRepl, add words between the quote marks, separate with a comma, NO spaces ' To only highlight the found words (i.e. not replace with other words), either use StrRepl = StrFind OR use the SAME words in the same order in the StrRepl list as for the StrFind list; comment/uncomment to reflect the one you're using ' To replace a word with another and highlight it, put the new word in the StrRepl list in the SAME position as the word in the StrFind list you want to replace; comment/uncomment to reflect the one you're using StrFind = "very,just,rarely,often,frequently,majority,most,minority,some,perhaps,maybe,regularly,sometimes,occasionally,best,worst,worse,better,seldom,few,many" StrRepl = StrFind ' StrRepl = "very,just,rarely,often,frequently,majority,most,minority,some,perhaps,maybe,regularly,sometimes,occasionally,best,worst,worse,better,seldom,few,many" Set RngTxt = Selection.Range ' Set highlight color - options are listed here: https://docs.microsoft.com/en-us/office/vba/api/word.wdcolorindex ' main ones are wdYellow, wdTurquoise, wdBrightGreen, wdPink Options.DefaultHighlightColorIndex = wdTurquoise Selection.HomeKey wdStory ' Clear existing formatting and settings in Find and Replace fields Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With ActiveDocument.Content.Find .Format = True .MatchWholeWord = True .MatchAllWordForms = False .MatchWildcards = False .Wrap = wdFindContinue .Forward = True For i = 0 To UBound(Split(StrFind, ",")) .Text = Split(StrFind, ",")(i) .Replacement.Highlight = True .Replacement.Text = Split(StrRepl, ",")(i) .Execute Replace:=wdReplaceAll Next i End With End Sub
