Hello all,
I'm looking to write a macro within Word that skims the document for all nouns, pronouns, and proper nouns and looks back 4 characters from the front of the word for the following text "the " including the space, and highlight the section trimmed if it does not match "the ", and include the noun/pronoun/proper noun within the highlighting.
Ideally, the scenario would look something like this...
"Cat walked into room and the cat sniffed McDonald's food, cat was center of attention for everyone else in room"
The result would look something like this, underlining to represent sections highlighted from the macro.
"Cat walked into room and the cat sniffed McDonald's food, cat was center of attention for everyone else in room."
Tried to capture each scenario where a the would be needed, but purposely excluded it.
Currently, this is the macro I have scriptted that is working but want to add to it's effort, it's a little messy so any advice would be greatly appreciated.
I'm looking to write a macro within Word that skims the document for all nouns, pronouns, and proper nouns and looks back 4 characters from the front of the word for the following text "the " including the space, and highlight the section trimmed if it does not match "the ", and include the noun/pronoun/proper noun within the highlighting.
Ideally, the scenario would look something like this...
"Cat walked into room and the cat sniffed McDonald's food, cat was center of attention for everyone else in room"
The result would look something like this, underlining to represent sections highlighted from the macro.
"Cat walked into room and the cat sniffed McDonald's food, cat was center of attention for everyone else in room."
Tried to capture each scenario where a the would be needed, but purposely excluded it.
Currently, this is the macro I have scriptted that is working but want to add to it's effort, it's a little messy so any advice would be greatly appreciated.
Code:
Sub ReviewDocs()
'
' ReviewDocs Macro
'
'
Application.ScreenUpdating = False
Dim arrWords, i As Long
With ActiveDocument.Range.Find
Options.DefaultHighlightColorIndex = wdBrightGreen
arrWords = Array(" ", " ", "!", "+", "=", ">", "<", "'", "*", _
"coworker", "construct", "input", "key", "because", "utilized", _
"you", "We", "our", "Can't", "could've", "should've", "Don't", _
"doesn't", "couldn't", "Won't", "aren't", "Will", "Should", _
"jr.", "sr.", "mod", "doc", "i.e.", "e.g.", "4506t", "double click", _
"drop down", "right click", "auto commit", "auto populate", "co borrower", _
"coborrower", "cosigner", "co signer", "Deed in lieu", "face to face", _
"j day", "non profit", "owner occupied", "non owner occupied", "non recordable", _
"w2", "hit", "cost efficient", "cost effictive", "in order to", "utilize", _
"must", "in general", "FYI", "please", "notate", "click on", "&", "1", "1/", "2", _
"2/", "3", "3/", "4", "4/", "5", "5/", "6", "6/", "7", "7/", "8", "8/", "9", "9/", _
"10/", "11/", "12/", "1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th", _
"24/7", "jan", "feb", "mar", "apr", "jun", "jul", "aug", "sept", "e mail", "e-mail", _
"digest", "depress", "cease", "AM", "PM", "min", "and/or")
.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("oct", "nov", "dec", "mon", "tues", "wed", _
"thurs", "fri", "sat", "sun", "account holder", "implied", _
"till", "prior to", "provided that", "reiterate", "irregardless", _
"n/a", "inferred", "first come", "utilize", "forwards", "whom", _
"first served", "first-come", "first-served", "fixed rate", "he/she", _
"s/he", "his/her", "h/er", "etc", "et al", "et cetera", "via", "lob", _
"log on", "log off", "log-on", "log-off")
Options.DefaultHighlightColorIndex = wdBrightGreen
.Replacement.Highlight = True
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
.Execute Replace:=wdReplaceAll
Next
Options.DefaultHighlightColorIndex = wdYellow
arrWords = Array("absolute necessity", "accounted for the fact that", _
"actual fact", "advance planning", "afix a signature to", _
"after the conclusion of", "as a result of", "as per your request", _
"as soon as", "at a much greater rate than", "at all times", "at the time of", _
"at this time", "at which time", "at your earliest convenience", _
"based on the fact that", "be of assistance to", "by way of", _
"call your attention to the fact that", "collaborate together", "consensus of opinion", _
"despite the fact that", "downward adjustment", "enclosed please find", _
"Feel free to check back", "few in number", "for the purpose of", "for this reason", _
"For your viewing pleasure", "great deal of", "hassle-free", "head of", _
"I am writing this letter to inform you that", "I was unaware of the fact that", _
"In the amount of", "in a hasty manner", "in accordance with", "in lieu of", _
"in order to", "in receipt of", "in reference to", "in spite of the fact that")
.Replacement.Highlight = True
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
.Execute Replace:=wdReplaceAll
Next
Options.DefaultHighlightColorIndex = wdYellow
arrWords = Array("in the near future", "interact with each other", _
"Is dependent upon", "it came to my attention", "it is incumbent upon us", _
"it is necessary that you", "majority of", "mix together", "new innovation", _
"on account of", "One-stop shopping", "owing to the fact that", _
"pause for a moment", "please be advised", "prior to", "provided that", _
"reach a conclusion", "refer back", "regarding", "reiterate", "so as to", _
"still continues to", "subsequent to", "the fact that I arrived", _
"the question as to", "there is no doubt that", "until such time as")
.Replacement.Highlight = True
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
.Execute Replace:=wdReplaceAll
Next
End With
Application.ScreenUpdating = True
End Sub
