Navigation Bar

HOME  |   ABOUT ME  |   MERM-8  |   DISNEY VILLAINS  |   VIDEO GAME MEMORIES  |   OTHER WORKS

Quote Generator



Wednesday, April 28, 2010

Macros

Ok, I'm bored with putting all these together piece-meal, so I just put up the whole big file after the jump/break.

Last Updated: 11/07/14

How do I put this on my machine?

1. Copy all the text in this file (or after the break).
2. Open Microsoft Word.
3. Press Alt+F8 (or go to Tools -> Macro -> Macros)
4. Click Edit. Microsoft Visual Basic will open.
5. In the project window (upper right), select Normal->Modules->NewMacros
6. Paste the code below into the text pane.
7. Click save and close Microsoft Visual Basic.

How do I use these?

In Microsoft Word, press Alt+F8 or go to Tools -> Macro -> Macros. This will show you a list of the available macros. This is the list you should see.


To run any of these, just highlight the one you want and click "run". Be forewarned: some of them will just highlight words, but some of them will alter your document, and I don't know if "undo" will fix it all. Know what you're clicking on before you run it (and there's explanations below). Plus, these are not thoroughly tested--I am not a VB programmer, and I have no beta testers.


HELP!  One of your stupid Macros locked up Word!

Press Ctrl+Break to get out of the macro.  There's likely a piece of code that's looping forever.  Let me know, and I'll try to fix it.


What do all these do?

First, a note: some of these macros actually run other macros that you can't see in the list. I'll list them, and their explanations below. But if you want to make any of these visible--so you can run them separately--remove the word "private" from the beginning of the function name.  If you need more info/explanation, leave me a comment.  I'm not a technical writer, so I don't know how well I'm explaining this.

And one more thing, these are meant to be run in order. Each one "resets" the highlighting. So if you click "Find Long Sentences", and then "Find Questionable Words", it'll remove all the previous highlighting it did for the long sentences. You aren't supposed to run them all one after the other.

Why? For one, it would turn the document into a piece of modern art with all the colored highlighting. For another, that's too much for a writer to look at all at once. You should concentrate on one phase at a time.

A_Clean_Up_Document

This fixes some common formatting and style errors that are either hard to see, or the fault of Microsoft's infinite wisdom that it knows what you want to do.

1. Put two spaces after each sentence (should be smart enough around the quotes)
2. Replace manual line breaks - if you ever toggle on "view formatting", there should be a little ¶ after each paragraph. However, sometimes there are little left-pointing arrows (↵) instead. These can mess stuff up if you switch font sizes.
3. Replace smart quotes with straight quotes - I hate smart quotes and smart apostrophes. They never align right, and they don't C & P into any other format. Word allows you to turn them off, but if you type doesnt, Word will auto-correct you to doesn’t (with the smart apostrophe) instead of doesn't.

B_Toggle_Grammar_Underline

Right now, this is a no-operation to remind me to turn on my grammar underliner. I have my Word grammar checker set to only find passive voice (and all the other stuff, either the macros will find or Word doesn't do a good job with it). I haven't been able to get the macro right to simply turn on underline grammar, only select passive voice, and recheck the document. So this just pops up a reminder.

To toggle the gramar underline, go to Options->Spelling & Grammar (or Proofing). Check "Mark grammar errors as you type". Click on Settings. Deselect everything except "Passive sentences". Then click "Check document".

C_Calculate_Word_Frequency

Not terribly useful for novels. For short stories, you can find out if you're using a word too often.

D_Count_Exclamation_Points

Too many exclamation points will make you sound like a teen girl writing an email. I think I heard somebody say no more than two to three in a novel. I didn't do highlighting because A) it's not hard to search and find the ! and B) it's hard to find a highlighted exclamation point. They're so thin and all.

E_Find_Long_Sentences

I usually set it to 20 max words for short stories and 23 for novels. Mostly, you're looking for run-ons and comma splices, but also, break up those sentences that are just too damn long. Sentences that list of things, or have distinctive divisions around clauses (like the emdash that J.K. Rowling's fond of) are okay, IMO.

F_Find_Dangerous_Phrases

There are some common "gotchas" that smear the effectiveness of a sentence through passive voice or unnecessary words. The sentence needs to be rewritten to be stronger, use better words, or maybe eliminated altogether. The input box refers to step number 5.

1. Instances of "he/she felt" or "he/she saw" - using this means you're filtering the sentence through someone else's POV, which dilutes the impact. We're not looking for things like "he felt a concrete wall", but "he felt bad".  That's the time you should show, not tell.  Any characters you write in the input box will be accounted for too (so you can highlight instances of "John felt" or "John saw").
2. Sentences that start with "It" - What you're looking for is when "it" either signifies that you're spoon-feeding info to the reader or not referring to a real subject. "It was raining". What is "it"? The sky? The Earth? The weather? Change these so that there's an actual subject. "Rain fell."
3. Instances of "it was" (and "it wasn't") - usually a sign of restating something obvious.
4. Instances of "there was" or "there were" - this is a variation of "to be" which is not terribly exciting. Indicates you should be using a better verb. (Note: Don't bother searching for the instances of "to be". You'll claw your eyes out after ten pages).
5. Instances of "was being" or "were being" - a clear indicator of passive voice.
6. Instances of "and then", ", and" & ", then" - two separate sentences joined for no reason. Try splitting them.

G_Find_Acronyms_In_Dialogue

Words like Dr., Mr., Lt., etc. are supposed to be written out in dialogue.  Traditional acronyms (like CPU, NASA, RAM) are okay.

H_Find_Past_Perfect

Past perfect is "had" and "had been".  Clearly, we're not looking for "the machine had a button".  We're looking for actions that were completed before something in the past.  Look for passive voice.

I_Find_Sentences_That_Begin_The_Same

Looks for repetition.  However, this algorithm is kinda buggy.  I think it gets all the positive indicators, but also picks up things that aren't sentences.  I'm still working on it.

J_Asked_vs_Said
I have a bad habit of making dialogue tags like "What is that?" John said.  Especially for rhetorical questions.  These should be asked.

K_Find_Present_Participle

Present participle is "was xxxing".  It's a continuous action, and often, you should be using "xxx".  For example, instead of "he was watching", it should be "he watched".  This is more immediate and less wordy.  Gerunds are not our friends.

L_Find_Cliche_Words

Looks for overused phrases and meaningless phrases often found in bad writing, like "spin around", "piercing", "needless to say", "down in the dumps", "utilize", "in order to", and so on.

M_Find_You_In_Narrative

Example: You would think that the earth is flat, but it is, in fact, round.  That's not good, that's a quick shift into 2nd-person perspective.  You could use "One would think..." but that's a bit lazy too.  Try for a better subject like "Most people thought..." or "Common knowledge stated the earth..."

N_Find_That

Not my best title.  Finds instances of the word "that" which is also one of my crutch words.

O_Find_Single_Quotes

The only time you should be using single quotes is when you're using dialogue inside of dialogue.  All other times, use double quotes.

P_Find_Questionable_Adverbs

Probably one of the most useful macros. They say you should search and destroy words that end in -ly.  Well, why not let someone else do it?  OK, it won't destroy them, but it'll highlight them.

You'll notice in the code that there is an adverb exclusion list (adverbExceptionList). These are the words that are ignored in the adverb search--words like "fly" (verb) or "family" (noun) or "steely" (adjective). If you find some "-ly" words that are not adverbs, add them to this list.

Also note: there will be a prompt to ask you if you want to exclude searching in quotations. That means anything in quotes (dialogue) will be skipped. Because sometimes characters use bad grammar, adverbs, and cliches. And there's no point to highlight all that.

Q_Highlight_Improper_Digits

In narrative, all digits 10 and under should be written out.  In dialogue, all digits should be written out.

R_Find_Common_Apostrophe_Errors

Highlights all instances of it's, its, her's, and who's/whose. It's and its are two that, although I know when to use each, I still write the wrong one sometimes. This will point out each one so you can quick review them. What I do is, I read the phrase, and in my head, I read it as it is. If it sounds right, the word should be it's. If not, the word should be its.

Her's is not a real word. It's hers. There's no his's or hi's, so there's no her's.

Who's is a contraction of who is (the equivalent of it's).  Whose is the possessive of who (the equivalent of its).

S_Find_Overused_Words

Works much like Find Dangerous Phrases and Find Cliche Words.  Looks for bad writing tip-offs like "um", "er", "uh" (unnecessary and wordy), "attractive", "colorful" (telling instead of showing) "begin to", "start to" (only necessary when the action is being interrupted) "found his", "just", "kind of", "many", "seems to", "somehow", "sighed", "glanced" and so on.

X_Convert_Formatting_to_Plain_Text

This is not supposed to be run with the other macros.  This is just something I use when I need to convert a work to plain text for e-mail or manuscript formatting.  It changes all instances of bold to *asterisks* and italics to _underscores_.

User-Friendliness Tip: Want to Change What Color Things Are Highlighted In?

Not a problem. You'll notice at the top of the file is a list of the valid colors. Just go into any function and put in the color you want. Some functions, especially the multi-step ones, use the same color for each. But each mini-function chooses its own color. So you can make "it's" as dark blue and "its" as teal. Just look for where the current color is used and replace it.

One Last Thought

This is not meant to be an end-all-be-all hunter-killer. Just because it gets highlighted doesn't mean you HAVE to change it. Examine the suspect words and see if they're appropriate, used effectively, and don't need to be replaced by something stronger. If you're in a first draft, and you can remove/change half the stuff that gets highlighted, you're probably doing good. But just because it ends in 'ly' doesn't mean you have to get rid of it. If it works, let it work.

If you have any questions or need clarification, please send me an e-mail or leave a comment. I'll help you AND update this post so that others don't have the same problem. But I can't help anything if I don't know what the problem is. So please don't think twice about dropping a line.



'NOTE: All non-private functions should start with "clear all highlighting"

'wdBlack - don't use
'wdWhite - don't use
'wdGray25 - little light
'wdGray50 - used
'wdPink - used
'wdDarkRed - used
'wdRed - used
'wdDarkYellow - dark
'wdYellow - used
'wdBrightGreen - used
'wdGreen - dark
'wdTeal - dark
'wdTurquoise - used
'wdBlue - dark
'wdDarkBlue
'wdViolet - dark

'Chr(134) = start of document marker †
'Chr(145) = start quote '
'Chr(146) = end quote '
'Chr(147) = start quote "
'Chr(148) = end quote "
'Chr(39) = straight quote '
'Chr(34) = straight quote "

'Puts two spaces after each sentence, replaces manual line breaks with ^p, makes all quotes straight
Sub A_Clean_Up_Document()
    Application.Run MacroName:="Clear_All_Highlighting"
    Application.Run MacroName:="Put_Two_Spaces_After_Each_Sentence"
    Application.Run MacroName:="Replace_Manual_Line_Breaks"
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Highlight dangerous sentences
Sub F_Find_Dangerous_Phrases()
    Application.Run MacroName:="Clear_All_Highlighting"
    Application.Run MacroName:="Find_Felt_And_Saw"
    Application.Run MacroName:="Find_Sentences_That_Start_With_It"
    Application.Run MacroName:="Find_It_Was"
    Application.Run MacroName:="Find_There_Was"
    Application.Run MacroName:="Find_Was_Being"
    Application.Run MacroName:="Find_And_Then"
End Sub

'Finds sentences over X words long - pink
Sub E_Find_Long_Sentences()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim totalWords As Integer
    Dim maxwords As Integer
    
    maxwords = 23
    totalWords = 0
    
    For Each mySentence In ActiveDocument.Sentences
        For Each myWord In mySentence.Words
            SingleWord = Trim(LCase(myWord))
            If SingleWord > "a" And SingleWord < "z" Then
                totalWords = totalWords + 1
            End If
        Next myWord
        If totalWords > maxwords Then
            mySentence.Select
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
            Selection.Range.HighlightColorIndex = wdPink
        End If
        totalWords = 0
    Next mySentence
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst

End Sub

'Highlight instances of its and it's and her's - turquoise
Sub R_Find_Common_Apostrophe_Errors()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "it's"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdTurquoise
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdTurquoise
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "its"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdTurquoise
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdTurquoise
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "her's"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdTurquoise
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdTurquoise
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "who's"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdTurquoise
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdTurquoise
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "whose"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdTurquoise
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdTurquoise
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Finds and highlights adverbs - yellow
Sub P_Find_Questionable_Adverbs()

On Error GoTo Err_HighlightWords

    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim adverbExceptionList
    Dim adverbColor As WdColorIndex
    
    adverbExceptionList = Array("only", "anomaly", "deadly", "partly", "dragonfly", "lily", "firefly", "wriggly", "freakishly", "wooly", "spindly", "comply", "girly", "woolly", "squiggly", "scaly", "underbelly", "friendly", "tingly", "supply", "resupply", "oily", "chilly", "assembly", "burly", "shapely", "early", "daily", "assembly", "bodily", "family", "homily", "Billy", "Sally", "multiply", "imply", "gangly", "apply", "bully", "belly", "silly", "jelly", "holy", "lovely", "holly", "fly", "July", "rely", "reply", "Lilly", "sully", "gully", "prickly", "crawly", "curly", "sly", "ugly", "motherly", "spritely", "lonely", "sickly", "steely", "melancholy", "wobbly", "godly", "owly", "wily", "apply", "reapply")
    adverbColor = wdYellow
        
    'variables
    Dim word
    Dim rng As Range
    Dim excluded As Boolean
    Dim story As WdStoryType
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Iterate through each document section
    For Each rng In ActiveDocument.StoryRanges
        ' Work only with the main body, footnotes and endnotes
        story = rng.StoryType
        If story <> wdMainTextStory And story <> wdFootnotesStory And story <> wdEndnotesStory Then
            GoTo NextRange
        End If
        ' Do the adverb highlighting
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        With rng.Find
            .Text = "<[! ^13]@(ly)>"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Do While rng.Find.Execute(Replace:=wdNone) = True
            If rng.Text = "" Then
                Exit Do
            End If
            excluded = False
            For Each word In adverbExceptionList
                If LCase(rng.Text) = LCase(word) Then
                    excluded = True
                    Exit For
                End If
            Next
            
            If Not excluded Then
                ' Highlight current selection
                rng.HighlightColorIndex = adverbColor
            End If
        Loop
NextRange:
    Next
    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    'MsgBox "Word highlighting complete!"
    Exit Sub
Err_HighlightWords:
    MsgBox Err.Description
End Sub

'Finds and highlights overused words - yellow
Sub S_Find_Overused_Words()

    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim overusedList
    Dim overusedColor As WdColorIndex
    Dim yes As String
        
    yes = "6"
    overusedList = Array("er", "um", "ah", "uh", "yeah", "hey", "all of a sudden", "almost", "appears", "attractive", "begin to", "beginning to", "began to", "start to", "started to", "starting to", "close to", "colorful", "crossing", "creeping", "crept", "embarrassing", "even", "eyebrow", "fabulous", "fascinating", "found herself", "found himself", "found his", "found her", "groan", "handsome", "hilarious", "just", "just then", "kinda", "kind of", "many", "momentous", "most", "more and more", "nondescript", "occur", "occurs", "powerful", "quite", "seemed to", "seems to", "seeming to", "shows", "showed", "since", "some", "something in", "somewhat", "somehow", "sort of", "very", "went", "sigh", "sighed", "glance", "glanced", "blink", "blinked", "stare", "stared", "look", "looked", "growl", "growled", "rather", "pretty")
    overusedColor = wdYellow
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    Dim excludeQuotations
    Dim onlyQuotations
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    excludeQuotations = MsgBox(Prompt:="Do you want to skip quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Exclude Quotations?")
    
    If excludeQuotations <> yes Then
        onlyQuotations = MsgBox(Prompt:="Do you want to do only quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Only Quotations?")
    End If
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do overused word highlighting
    Options.DefaultHighlightColorIndex = overusedColor
            
    For Each word In overusedList
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = word
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                If excludeQuotations = yes Then
                    'from our selection point, work backwards.  If the first quote is a start quote,_
                    'we are inside dialogue, so skip it.  If first quote I see is an end quote, we _
                    'are outside the dialogue tag, so highlight it
                    Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                        Selection.MoveLeft Unit:=wdCharacter, Count:=1
                    Loop
                
                    'End Quote or Dagger (start of doc)
                    If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                        rng.Select
                        Selection.Range.HighlightColorIndex = overusedColor
                    End If
                Else
                    If onlyQuotations = yes Then
                        'from our selection point, work backwards.  If the first quote is a start quote,_
                        'we are inside dialogue, so highlight it.  If first quote I see is an end quote, we _
                        'are outside the dialogue tag, so skip it
                        Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                            Selection.MoveLeft Unit:=wdCharacter, Count:=1
                        Loop
                
                        'Start Quote
                        If Selection.Characters(1) = Chr(147) Then
                            rng.Select
                            Selection.Range.HighlightColorIndex = overusedColor
                        End If
                    Else
                       Selection.Range.HighlightColorIndex = overusedColor
                    End If
                End If
            Loop
        Next rng
    Next word

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Finds and highlights overused words and cliches - yellow
Sub L_Find_Cliche_Words()

    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim clicheList
    Dim clicheColor As WdColorIndex
    Dim yes As String
        
    yes = "6"
    clicheColor = wdYellow
    clicheList = Array("furrow", "furrowed", "very", "the reason for", "past history", "spin around", "spun around", "this is why", "end result", "it is possible that", "the possibility exists", "for all intents and purposes", "there is a chance that", "is able to", "has the opportunity to", "past memories", "future plans", "sudden crisis", "terrible tragedy", "as a matter of fact", "quite frankly", "all the time", "white as a sheet", "as soon as possible", "at the very least", "down in the dumps", "in the nick of time", "hat in hand", "keep your mouth shut", "made a run for it", "utilize", "in order to", "the fact that", "framed by", "swelling bosom", "heart-shaped face", "set off by", "revealed", "limpid pools", "better than ever", "for some reason", "for some curious reason", "a number of", "as everybody knows", "she didn't know where she was", "he didn't know where he was", "they didn't know where they were", "things were getting out of hand", "it came as no surprise", "it was beyond", _
        "needless to say", "without thinking", "lived in the moment", "well in advance", "emotional roller coaster", "little did i know", "little did he know", "little did she know", "little did they know", "to no avail", "did I say that out loud", "not necessarily in that order", "from hell", "on acid", "Houston, we have a problem", "I'm standing right here", "check, please", "check please", "threw up in my mouth", "can't feel my legs", "you do the math", "you had me at", "sigh of relief")
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    Dim excludeQuotations
    Dim onlyQuotations
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    excludeQuotations = MsgBox(Prompt:="Do you want to skip quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Exclude Quotations?")
    
    If excludeQuotations <> yes Then
        onlyQuotations = MsgBox(Prompt:="Do you want to do only quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Only Quotations?")
    End If
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do cliche word highlighting
    Options.DefaultHighlightColorIndex = clicheColor
            
    For Each word In clicheList
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = word
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                If excludeQuotations = yes Then
                    'from our selection point, work backwards.  If the first quote is a start quote,_
                    'we are inside dialogue, so skip it.  If first quote I see is an end quote, we _
                    'are outside the dialogue tag, so highlight it
                    Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                        Selection.MoveLeft Unit:=wdCharacter, Count:=1
                    Loop
                
                    'End Quote or Dagger (start of doc)
                    If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                        rng.Select
                        Selection.Range.HighlightColorIndex = clicheColor
                    End If
                Else
                    If onlyQuotations = yes Then
                        'from our selection point, work backwards.  If the first quote is a start quote,_
                        'we are inside dialogue, so highlight it.  If first quote I see is an end quote, we _
                        'are outside the dialogue tag, so skip it
                        Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                            Selection.MoveLeft Unit:=wdCharacter, Count:=1
                        Loop
                
                        'Start Quote
                        If Selection.Characters(1) = Chr(147) Then
                            rng.Select
                            Selection.Range.HighlightColorIndex = clicheColor
                        End If
                    Else
                        Selection.Range.HighlightColorIndex = clicheColor
                    End If
                End If
            Loop
        Next rng
    Next word

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Count Exclamation points in document
Sub D_Count_Exclamation_Points()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim totalExPoints As Integer
    totalExPoints = 0
    
    For Each myCharacter In ActiveDocument.Characters
        If myCharacter = "!" Then
            totalExPoints = totalExPoints + 1
        End If
    Next myCharacter
       
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    
    MsgBox ("Total Exclamation Points = " & totalExPoints)
End Sub

'Put two spaces at the end of each sentence (corrects for initials and quotations)
Private Sub Put_Two_Spaces_After_Each_Sentence()
    useTwoSpaces = MsgBox(Prompt:="Do you want to put two or one spaces after each sentence? (2 = Yes, 1 = No)", Buttons:=vbYesNo + vbDefaultButton2, Title:="Two Spaces")
    
    If useTwoSpaces = "6" Then
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            .Forward = True
            .Format = False
            .Wrap = wdFindContinue
            .Text = "([.\?\!]) {1,}"
            .Replacement.Text = "\1  "
            .Execute Replace:=wdReplaceAll
            .Text = "([.\!\?]) {3,}([A-Z])"
            .Replacement.Text = "\1  \2"
            .Execute Replace:=wdReplaceAll
            'This should prevent most cases of improper double spacing
            'in names (e.g., F. Lee Bailey, George W. Bush, etc.)
            .Text = "([!A-Z][A-Z].)  ([A-Z])" 'Two spaces between ) and (
            .Replacement.Text = "\1 \2"
            .Execute Replace:=wdReplaceAll
        End With
        
        'Correct Mr., Dr., etc.
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Mr.  "
            .Replacement.Text = "Mr. "
            .Execute Replace:=wdReplaceAll
        End With
    
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .MatchCase = True
            .Forward = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Mrs.  "
            .Replacement.Text = "Mrs. "
            .Execute Replace:=wdReplaceAll
        End With
    
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .Format = False
            .MatchCase = True
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Ms.  "
            .Replacement.Text = "Ms. "
            .Execute Replace:=wdReplaceAll
        End With
    
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Dr.  "
            .Replacement.Text = "Dr. "
            .Execute Replace:=wdReplaceAll
        End With
        
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Lt.  "
            .Replacement.Text = "Lt. "
            .Execute Replace:=wdReplaceAll
        End With
        
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "vs.  "
            .Replacement.Text = "vs. "
            .Execute Replace:=wdReplaceAll
        End With

            
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "P.A.  "
            .Replacement.Text = "P.A. "
            .Execute Replace:=wdReplaceAll
        End With
        
                With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = False
            .Forward = True
            .MatchCase = True
            .Format = False
            .MatchWholeWord = True
            .Wrap = wdFindContinue
            .Text = "Ph.D.  "
            .Replacement.Text = "Ph.D. "
            .Execute Replace:=wdReplaceAll
        End With
    Else
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            .Forward = True
            .Format = False
            .Wrap = wdFindContinue
            .Text = "([.\?\!]) {1,}"
            .Replacement.Text = "\1 "
            .Execute Replace:=wdReplaceAll
            .Text = "([.\!\?]) {3,}([A-Z])"
            .Replacement.Text = "\1 \2"
            .Execute Replace:=wdReplaceAll
            'This should prevent most cases of improper double spacing
            'in names (e.g., F. Lee Bailey, George W. Bush, etc.)
            .Text = "([!A-Z][A-Z].) ([A-Z])" 'Two spaces between ) and (
            .Replacement.Text = "\1 \2"
            .Execute Replace:=wdReplaceAll
        End With
    End If
    
    'Correct ellipses
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = False
        .Forward = True
        .Format = False
        .Wrap = wdFindContinue
        .Text = "...  "
        .Replacement.Text = "... "
        .Execute Replace:=wdReplaceAll
    End With
    
End Sub

'Replaces those "enter" arrows with real paragraph marks
Private Sub Replace_Manual_Line_Breaks()
    Dim myStoryRange As Range

    For Each myStoryRange In ActiveDocument.StoryRanges
        With myStoryRange.Find
            .Text = "^l"
            .Replacement.Text = "^p"
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
    Next myStoryRange
End Sub

'Replace all instances of smart quotes with straight quotes
Private Sub Replace_Smart_Quotes_With_Straight_Quotes()
    Dim myStoryRange As Range

    For Each myStoryRange In ActiveDocument.StoryRanges
        With myStoryRange.Find
            .Text = Chr(145)
            .Replacement.Text = Chr(39)
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        
        With myStoryRange.Find
            .Text = Chr(146)
            .Replacement.Text = Chr(39)
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        
        With myStoryRange.Find
            .Text = Chr(147)
            .Replacement.Text = Chr(34)
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        
        With myStoryRange.Find
            .Text = Chr(148)
            .Replacement.Text = Chr(34)
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
    Next myStoryRange
End Sub

'Replace all instance of straight quotes with smart quotes - corrects for alignment
Private Sub Replace_Straight_Quotes_With_Smart_Quotes()

    Dim rngstory As word.Range
    Dim myRange As Range
    Dim SmartQuote As Boolean

    Options.AutoFormatAsYouTypeReplaceQuotes = True
    For Each rngstory In ActiveDocument.StoryRanges
        Do
            If rngstory.StoryLength >= 2 Then
                QuoteToggle rngstory
            End If
        Set rngstory = rngstory.NextStoryRange
        Loop Until rngstory Is Nothing
    Next rngstory
    Options.AutoFormatAsYouTypeReplaceQuotes = False
End Sub

'Toggle between smart quote and straight quote
Private Sub QuoteToggle(ByVal rngstory As word.Range)
    With rngstory.Find
        'quote marks
        .Text = Chr$(34)
        .Replacement.Text = Chr$(34)
        .Execute Replace:=wdReplaceAll
        'apostrophe
        .Text = Chr$(39)
        .Replacement.Text = Chr$(39)
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'find sentences that start with the same two words - bright green
Sub I_Find_Sentences_That_Begin_The_Same()

On Error GoTo LocalError

    Application.Run MacroName:="Clear_All_Highlighting"
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    
    'convert ellipses temporarily
    With ActiveDocument.Content.Find
        .Text = "..."
        .Replacement.Text = "…"
        .Execute Replace:=wdReplaceAll
    End With
        
    Dim wordsInSentence
    Dim wholeSentence As String
    Dim firstWordOfPrevSentence As String
    Dim firstWordOfCurrentSentence As String
    Dim isGhostSentence As Boolean
    Dim tmpWord As String
    Dim sentenceCtr As Integer
    Dim wordCtr As Integer
    sentenceCtr = 1
    
    For Each mySentence In ActiveDocument.Sentences
        wholeSentence = mySentence
        'NOTE: Word sometimes has ghost sentences where it "duplicates" a sentence in the array, usually due to a tab after a period
        isGhostSentence = Len(removeCharacters(wholeSentence)) <= 0 Or Len(removeCharacters(ActiveDocument.Sentences(sentenceCtr))) <= 0
        If Not (isGhostSentence) Then
            wordsInSentence = Split(mySentence)
            firstWordOfCurrentSentence = wordsInSentence(0)
            firstWordOfCurrentSentence = removeCharacters(firstWordOfCurrentSentence)
            wordcounter = 1

            If Not (sentenceCtr = 0) Then 'if not first sentence
                If (firstWordOfPrevSentence = firstWordOfCurrentSentence) Then
                                        
                    'Highlight first word in CURRENT sentence
                    Do While Not (InStr(removeCharacters(mySentence.Words(wordcounter)), firstWordOfPrevSentence) > 0)
                        'this is to make sure we're not counting a leading space
                        wordcounter = wordcounter + 1
                        If (wordcounter <= ActiveDocument.Sentences(sentenceCtr - 1).Words.Count) Then
                            Exit Do
                        End If
                    Loop
                    
                    If (wordcounter <= ActiveDocument.Sentences(sentenceCtr - 1).Words.Count) Then
                        mySentence.Words(wordcounter).Select
                        Selection.Range.HighlightColorIndex = wdBrightGreen
                    End If
                    
                    'Highlight first word in PREVIOUS sentence
                    wordcounter = 1

                    Do While Not (InStr(removeCharacters(ActiveDocument.Sentences(sentenceCtr - 1).Words(wordcounter)), firstWordOfPrevSentence) > 0)
                        wordcounter = wordcounter + 1
                        If (wordcounter <= ActiveDocument.Sentences(sentenceCtr - 1).Words.Count) Then
                            Exit Do
                        End If
                    Loop
                    
                    If (wordcounter <= ActiveDocument.Sentences(sentenceCtr - 1).Words.Count) Then
                        ActiveDocument.Sentences(sentenceCtr - 1).Words(wordcounter).Select
                        Selection.Range.HighlightColorIndex = wdBrightGreen
                    End If
                End If
            End If
        
            firstWordOfPrevSentence = wordsInSentence(0)
            firstWordOfPrevSentence = removeCharacters(firstWordOfPrevSentence)
        End If
        sentenceCtr = sentenceCtr + 1
    Next mySentence
        
    'convert ellipses back
    With ActiveDocument.Content.Find
        .Text = "…"
        .Replacement.Text = "..."
        .Execute Replace:=wdReplaceAll
    End With
    
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    
LocalError:
    Dim Msg As String
    If Err.Number <> 0 Then
        Msg = "Error # " & Err.Number & " - " & Err.Description
        MsgBox (Msg)
    End If
End Sub

'find sentences that start with It - light gray
Private Sub Find_Sentences_That_Start_With_It()
    On Error GoTo LocalError
    
    'convert ellipses temporarily
    With ActiveDocument.Content.Find
        .Text = "..."
        .Replacement.Text = "…"
        .Execute Replace:=wdReplaceAll
    End With
    
    'convert question marks temporarily
    With ActiveDocument.Content.Find
        .Text = "?"
        .Replacement.Text = Chr(165)
        .Execute Replace:=wdReplaceAll
    End With
        
    Dim i As Integer
    Dim saveWord As String
    Dim sentenceIndex As Integer
    saveWord = "it"
    sentenceIndex = 1
    lastSentenceFirstWordIndex = 0
    
    For Each mySentence In ActiveDocument.Sentences
        firstWordFound = False
        i = 1
        
        Do Until (firstWordFound Or i > mySentence.Words.Count)
            
            If i <= mySentence.Words.Count Then
                tmpWord = Trim(LCase(mySentence.Words(i)))
                If tmpWord >= "a" And tmpWord <= "z" Then
                    firstWordFound = True
                    If (tmpWord = saveWord) Then
                        
                        mySentence.Words(i).Select
                        If mySentence.Words(i).Characters.Last = " " Then
                            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                        End If
                        Selection.Range.HighlightColorIndex = wdGray50
                        
                    End If
                Else
                    i = i + 1
                End If
            End If
        Loop
        If i <= mySentence.Words.Count Then
            lastSentenceFirstWordIndex = i
        End If
        sentenceIndex = sentenceIndex + 1
    Next mySentence
    
    'convert ellipses back
    With ActiveDocument.Content.Find
        .Text = "…"
        .Replacement.Text = "..."
        .Execute Replace:=wdReplaceAll
    End With
    
    'convert question marks back
    With ActiveDocument.Content.Find
        .Text = Chr(165)
        .Replacement.Text = "?"
        .Execute Replace:=wdReplaceAll
    End With
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    
LocalError:
    Dim Msg As String
    If Err.Number <> 0 Then
        Msg = "Error # " & Err.Number & " - " & Err.Description
        MsgBox (Msg)
    End If
End Sub

'Highlight instances of it was - light gray
Private Sub Find_It_Was()
    
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "it was"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "It was"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Highlight instances of there was / there were - light gray
Private Sub Find_There_Was()
    
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "there was"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "there were"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "There was"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "There were"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Highlight instances of was being / were being - light gray
Private Sub Find_Was_Being()
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "was being"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "were being"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "Was being"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "Were being"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Highlight instances of I/he/she saw, I/he/she felt, I/he/she watched and  - light gray
Private Sub Find_Felt_And_Saw()
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex

    sPrompt = "Please enter any character names you wish to use (ex. 'John, Mike, Emily') or leave blank"
    sTitle = "Enter Character Names"
    sInput = InputBox(sPrompt, sTitle)
    names = Split(sInput, ",")
    
    For Each rng In ActiveDocument.StoryRanges
        'felt
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "he felt"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "He felt"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "she felt"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "She felt"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "I felt"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        'saw
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "he saw"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "He saw"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "she saw"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "She saw"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "I saw"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        'watched
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "he watched"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "He watched"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "she watched"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "She watched"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "I watched"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
        For Each sName In names
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = True
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
            rng.WholeStory
            rng.Find.Text = sName + " saw"
            rng.Find.Wrap = wdFindStop
            Options.DefaultHighlightColorIndex = wdGray50
            Do While rng.Find.Execute
                rng.Select
                Selection.Range.HighlightColorIndex = wdGray50
            Loop
            
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = True
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
            rng.WholeStory
            rng.Find.Text = sName + " felt"
            rng.Find.Wrap = wdFindStop
            Options.DefaultHighlightColorIndex = wdGray50
            Do While rng.Find.Execute
                rng.Select
                Selection.Range.HighlightColorIndex = wdGray50
            Loop
            
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = True
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
            rng.WholeStory
            rng.Find.Text = sName + " watched"
            rng.Find.Wrap = wdFindStop
            Options.DefaultHighlightColorIndex = wdGray50
            Do While rng.Find.Execute
                rng.Select
                Selection.Range.HighlightColorIndex = wdGray50
            Loop
        Next sName
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Highlight instances of 'and then' - light gray
Private Sub Find_And_Then()
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "and then"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
        
      '  rng.Find.ClearFormatting
       ' rng.Find.Replacement.ClearFormatting
        'rng.Find.Forward = True
        'rng.Find.Replacement.Highlight = True
        'rng.Find.Format = True
        'rng.Find.MatchCase = False
        'rng.Find.MatchWholeWord = True
        'rng.Find.MatchWildcards = True
        'rng.Find.MatchSoundsLike = False
        'rng.Find.MatchAllWordForms = False
        'rng.WholeStory
        'rng.Find.Text = ", then"
        'rng.Find.Wrap = wdFindStop
        'Options.DefaultHighlightColorIndex = wdGray50
        'Do While rng.Find.Execute
         '   rng.Select
          '  Selection.Range.HighlightColorIndex = wdGray50
        'Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Clear all highlighting
Private Sub Clear_All_Highlighting()
    Options.CheckGrammarAsYouType = False
    Selection.WholeStory
    Options.DefaultHighlightColorIndex = wdNoHighlight
    Selection.Range.HighlightColorIndex = wdNoHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Convert instances of italics to underscores and bold to asterisks
Sub X_Convert_Formatting_to_Plain_Text()
    Application.Run MacroName:="Convert_Bold_to_Asterisks"
    Application.Run MacroName:="Convert_Italics_to_Underscores"
    Application.Run MacroName:="Convert_Underlines_to_Underscores"

    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Convert instances of italics to underlines and bold to asterisks
Sub X_Convert_Formatting_to_Manuscript()
    Application.Run MacroName:="Convert_Bold_to_Asterisks"
    Application.Run MacroName:="Convert_Italics_to_Underline"

    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Convert italicized text to _something_
Private Sub Convert_Italics_To_Underscores()
    ActiveDocument.Select
    
    With Selection.Find
        .ClearFormatting
        .Font.Italic = True
        .Text = ""
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Forward = True
        .Wrap = wdFindContinue
        
        Do While .Execute
            With Selection
                If InStr(1, .Text, vbCr) Then
                    ' Just process the chunk before any newline characters
                    ' We'll pick-up the rest with the next search
                    .Font.Italic = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well)
                If Not .Text = vbCr Then
                    .InsertBefore "_"
                    .InsertAfter "_"
                End If
                
                .Font.Italic = False
            End With
        Loop
    End With
    
    'Any bold will end up weird, so hack them back
    With ActiveDocument.Content.Find
        .Text = "_"
        .Font.Bold = True
        .Replacement.Text = "_"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'Convert underlined text to _something_
Private Sub Convert_Underlines_To_Underscores()
    ActiveDocument.Select
    
    With Selection.Find
        .ClearFormatting
        .Font.Underline = True
        .Text = ""
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Forward = True
        .Wrap = wdFindContinue
        
        Do While .Execute
            With Selection
                If InStr(1, .Text, vbCr) Then
                    ' Just process the chunk before any newline characters
                    ' We'll pick-up the rest with the next search
                    .Font.Underline = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well)
                If Not .Text = vbCr Then
                    .InsertBefore "_"
                    .InsertAfter "_"
                End If
                
                .Font.Underline = False
            End With
        Loop
    End With
    
    'Any bold will end up weird, so hack them back
    With ActiveDocument.Content.Find
        .Text = "_"
        .Font.Bold = True
        .Replacement.Text = "_"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'Convert italicized text to underlined text
Private Sub Convert_Italics_To_Underline()
    ActiveDocument.Select
    
    With Selection.Find
        .ClearFormatting
        .Font.Italic = True
        .Text = ""
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Forward = True
        .Wrap = wdFindContinue
        
        Do While .Execute
            With Selection
                Selection.Font.Italic = wdToggle
                Selection.Font.UnderlineColor = wdColorAutomatic
                Selection.Font.Underline = wdUnderlineSingle
            End With
        Loop
    End With
    
    'Any bold will end up weird, so hack them back
    With ActiveDocument.Content.Find
        .Text = "_"
        .Font.Bold = True
        .Replacement.Text = "_"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub


'Convert bold text to *something*
Private Sub Convert_Bold_To_Asterisks()
    ActiveDocument.Select
    
    With Selection.Find
        .ClearFormatting
        .Font.Bold = True
        .Text = ""
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Forward = True
        .Wrap = wdFindContinue
        
        Do While .Execute
            With Selection
                If InStr(1, .Text, vbCr) Then
                    ' Just process the chunk before any newline characters
                    ' We'll pick-up the rest with the next search
                    .Font.Bold = False
                    .Collapse
                    .MoveEndUntil vbCr
                End If
                                       
                ' Don't bother to markup newline characters (prevents a loop, as well)
                If Not .Text = vbCr Then
                    .InsertBefore "*"
                    .InsertAfter "*"
                End If
                
                .Font.Bold = False
            End With
        Loop
    End With
    
    'Any italic will end up weird, so hack them back
    With ActiveDocument.Content.Find
        .Text = "*"
        .Font.Italic = True
        .Replacement.Text = "*"
        .Replacement.Font.Italic = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

'Highlight instances of 'was xxxxing' - red
Sub K_Find_Present_Participle()

    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = False
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "was [! ]@ing"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdRed
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdRed
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Toggle Passive Voice auto-highlight
Sub B_Toggle_Grammar_Underline()
'    If Options.CheckGrammarAsYouType = True Then
 '       Options.CheckGrammarAsYouType = False
  '      ActiveDocument.ShowGrammaticalErrors = False
   ' Else
    '    Options.CheckGrammarAsYouType = True
     '   ActiveDocument.ShowGrammaticalErrors = True
    '
     '   'Do a no-op to trigger the recheck
      '  With ActiveDocument.Content.Find
       '     .Text = "e"
        '    .Replacement.Text = "e"
         '   .Execute Replace:=wdReplaceAll
   '     End With
    'End If
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    MsgBox "Turn on grammar highlighting -- check for passive voice!"
End Sub

'Calculate frequency of words used
Sub C_Calculate_Word_Frequency()
    Const maxwords = 9000          'Maximum unique words allowed
    Dim SingleWord As String       'Raw word pulled from doc
    Dim Words(maxwords) As String  'Array to hold unique words
    Dim Freq(maxwords) As Integer  'Frequency counter for unique words
    Dim WordNum As Integer         'Number of unique words
    Dim ByFreq As Boolean          'Flag for sorting order
    Dim ttlwds As Long             'Total words in the document
    Dim Excludes As String         'Words to be excluded
    Dim Found As Boolean           'Temporary flag
    Dim j, k, l, Temp As Integer   'Temporary variables
    Dim ans As String              'How user wants to sort results
    Dim tword As String            '

    ' Set up excluded words
    Excludes = "[the][a][of][is][to][for][by][be][and][are]"

    ' Find out how to sort
    ByFreq = True
    ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
    If ans = "" Then End
    If UCase(ans) = "WORD" Then
        ByFreq = False
    End If
    
    Selection.HomeKey Unit:=wdStory
    System.Cursor = wdCursorWait
    WordNum = 0
    ttlwds = ActiveDocument.Words.Count

    ' Control the repeat
    For Each aWord In ActiveDocument.Words
        SingleWord = Trim(LCase(aWord))
        'Out of range?
        If SingleWord < "a" Or SingleWord > "z" Then
            SingleWord = ""
        End If
        'On exclude list?
        If InStr(Excludes, "[" & SingleWord & "]") Then
            SingleWord = ""
        End If
        If Len(SingleWord) > 0 Then
            Found = False
            For j = 1 To WordNum
                If Words(j) = SingleWord Then
                    Freq(j) = Freq(j) + 1
                    Found = True
                    Exit For
                End If
            Next j
            If Not Found Then
                WordNum = WordNum + 1
                Words(WordNum) = SingleWord
                Freq(WordNum) = 1
            End If
            If WordNum > maxwords - 1 Then
                j = MsgBox("Too many words.", vbOKOnly)
                Exit For
            End If
        End If
        ttlwds = ttlwds - 1
        StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
    Next aWord

    ' Now sort it into word order
    For j = 1 To WordNum - 1
        k = j
        For l = j + 1 To WordNum
            If (Not ByFreq And Words(l) < Words(k)) _
              Or (ByFreq And Freq(l) > Freq(k)) Then k = l
        Next l
        If k <> j Then
            tword = Words(j)
            Words(j) = Words(k)
            Words(k) = tword
            Temp = Freq(j)
            Freq(j) = Freq(k)
            Freq(k) = Temp
        End If
        StatusBar = "Sorting: " & WordNum - j
    Next j

    ' Now write out the results
    tmpName = ActiveDocument.AttachedTemplate.FullName
    Documents.Add Template:=tmpName, NewTemplate:=False
    Selection.ParagraphFormat.TabStops.ClearAll
    With Selection
        For j = 1 To WordNum
            .TypeText Text:=Trim(Str(Freq(j))) _
              & vbTab & Words(j) & vbCrLf
        Next j
    End With
    System.Cursor = wdCursorNormal
    j = MsgBox("There were " & Trim(Str(WordNum)) & _
      " different words ", vbOKOnly, "Finished")
End Sub

'Find had or had been
Sub H_Find_Past_Perfect()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim rng As Range
    oldHighlight = Options.DefaultHighlightColorIndex
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "had been"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng

    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "had once been"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = True
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "had previously been"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "had"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        Do While rng.Find.Execute
            rng.Select
            Selection.Range.HighlightColorIndex = wdGray50
        Loop
    Next rng
    
    Options.DefaultHighlightColorIndex = oldHighlight
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Find uses of "you" that are not in dialogue
Sub M_Find_You_In_Narrative()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim highlightColor As WdColorIndex
    highlightColor = wdYellow
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do overused word highlighting
    Options.DefaultHighlightColorIndex = highlightColor
            
    
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = "you"
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue  If first quote I see is an end quote, we _
                'are outside the dialogue tag
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'End Quote or Dagger (start of doc) = narrative
                If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = highlightColor
                End If
            Loop
        Next rng
        
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = "your"
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue  If first quote I see is an end quote, we _
                'are outside the dialogue tag
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'End Quote or Dagger (start of doc) = narrative
                If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = highlightColor
                End If
            Loop
        Next rng
    

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst

End Sub

'Find possible instances of dialogue tags that should be 'asked' and not 'said'
Sub J_Find_Asked_vs_Said()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim highlightColor As WdColorIndex
    highlightColor = wdYellow
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do overused word highlighting
    Options.DefaultHighlightColorIndex = highlightColor
    
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.Text = "?"
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        
        Do While rng.Find.Execute
            rng.Select
            'from our selection point, work backwards.  If the first quote is a start quote,_
            'we are inside dialogue  If first quote I see is an end quote, we _
            'are outside the dialogue tag
            Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
            Loop
                
            'Start quote = dialogue
            If Selection.Characters(1) = Chr(147) Then
                rng.Select
                Do While Not (Selection = "." Or Selection = Chr(147) Or Selection.Range.End + 2 >= ActiveDocument.Range.End)
                    If (Selection.Words(1) = "said" Or Selection.Words(1) = "say" Or Selection.Words(1) = "says") Then
                        Selection.Words(1).HighlightColorIndex = highlightColor
                    End If
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                Loop
            End If
        Loop
    Next rng

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst

End Sub


'Find instances of "that" - gray
Sub N_Find_That()

    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim yes As String

    yes = "6"
    clicheColor = wdGray50
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    Dim excludeQuotations
    Dim onlyQuotations
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    excludeQuotations = MsgBox(Prompt:="Do you want to skip quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Exclude Quotations?")
    
    If excludeQuotations <> yes Then
        onlyQuotations = MsgBox(Prompt:="Do you want to do only quotations?", Buttons:=vbYesNo + vbDefaultButton2, Title:="Only Quotations?")
    End If
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do cliche word highlighting
    Options.DefaultHighlightColorIndex = clicheColor
    For Each rng In ActiveDocument.StoryRanges
        rng.Find.ClearFormatting
        rng.Find.Replacement.ClearFormatting
        rng.Find.Forward = True
        rng.Find.Replacement.Highlight = True
        rng.Find.Format = True
        rng.Find.MatchCase = False
        rng.Find.MatchWholeWord = True
        rng.Find.MatchWildcards = False
        rng.Find.MatchSoundsLike = False
        rng.Find.MatchAllWordForms = False
        rng.WholeStory
        rng.Find.Text = "that"
        rng.Find.Wrap = wdFindStop
        Options.DefaultHighlightColorIndex = wdGray50
        
        Do While rng.Find.Execute
            rng.Select
            If excludeQuotations = yes Then
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue, so skip it.  If first quote I see is an end quote, we _
                'are outside the dialogue tag, so highlight it
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'End Quote or Dagger (start of doc)
                If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = clicheColor
                End If
            Else
                If onlyQuotations = yes Then
                    'from our selection point, work backwards.  If the first quote is a start quote,_
                    'we are inside dialogue, so highlight it.  If first quote I see is an end quote, we _
                    'are outside the dialogue tag, so skip it
                    Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                        Selection.MoveLeft Unit:=wdCharacter, Count:=1
                    Loop
             
                    'Start Quote
                    If Selection.Characters(1) = Chr(147) Then
                        rng.Select
                        Selection.Range.HighlightColorIndex = clicheColor
                    End If
                Else
                    Selection.Range.HighlightColorIndex = clicheColor
                End If
            End If
        Loop
    Next rng
    
    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Find uses of single quotes not in double quotes
Sub O_Find_Single_Quotes()
    Application.Run MacroName:="Clear_All_Highlighting"
    
    'constants
    Dim quoteList
    Dim highlightColor As WdColorIndex
    Dim yes As String
        
    quoteList = Array("'", Chr(145), Chr(146))
    highlightColor = wdDarkRed
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    Options.DefaultHighlightColorIndex = digitColor
            
    For Each word In quoteList
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = word
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue  If first quote I see is an end quote, we _
                'are outside the dialogue tag
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'End Quote or Dagger (start of doc) = narrative
                If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                    rng.Select
                    If (Selection.Characters(1) = Chr(145)) Then
                        Do While Not (Selection.Characters().Last.Text = Chr(146))
                            'MsgBox (Selection.Characters().Last.Text)
                            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                        Loop
                    End If
                    Selection.Range.HighlightColorIndex = highlightColor
                End If
            Loop
        Next rng
    Next word

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Look for digits in narrative and dialogue
'WARNING: This seems to have a bad time with headers
Sub Q_Highlight_Improper_Digits()
    '10 and under should be written out in narrative
    'all digits in dialogue should be written out
    Application.Run MacroName:="Clear_All_Highlighting"
    
    Dim intMsgBoxResult As Integer
    
    intMsgBoxResult = MsgBox("Warning: This macro does not like headers or footers.  This is a bug I'm working on.  To ensure the macro completes properly, click Cancel and remove numbers (like page numbers) from your headers/footers.  Otherwise, click OK to continue.", vbOKCancel, "Warning")
    If intMsgBoxResult = vbCancel Then Exit Sub
            
    'constants
    Dim digitList
    Dim digitColor As WdColorIndex
    Dim yes As String
        
    digitList = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
    digitColor = wdYellow
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do overused word highlighting
    Options.DefaultHighlightColorIndex = digitColor
            
    For Each word In digitList
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = word
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = False
            rng.Find.MatchWholeWord = False
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue  If first quote I see is an end quote, we _
                'are outside the dialogue tag
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'End Quote or Dagger (start of doc) = narrative
                If Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = digitColor
                End If
                'Start quote = dialogue
                If Selection.Characters(1) = Chr(147) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = digitColor
                End If
            Loop
        Next rng
    Next word

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Look for abbreviations (like Dr. and Mr.) in dialogue
Sub G_Find_Abbreviations_In_Dialogue()
    
    Application.Run MacroName:="Clear_All_Highlighting"

    'constants
    Dim abbreviationList
    Dim abbreviationColor As WdColorIndex
        
    abbreviationList = Array("Dr.", "Mr.", "Lt.", "Mrs.", "Ms.")
    abbreviationColor = wdGray50
    
    'variables
    Dim word
    Dim rng As Range
    Dim oldTrack
    Dim oldHighlight
    
    ' Save current settings
    oldTrack = ActiveDocument.TrackRevisions
    oldHighlight = Options.DefaultHighlightColorIndex
    ActiveDocument.TrackRevisions = False
    
    Application.Run MacroName:="Replace_Straight_Quotes_With_Smart_Quotes"
    ActiveDocument.Characters(1).InsertBefore Chr(134)

    ' Do overused word highlighting
    Options.DefaultHighlightColorIndex = abbreviationColor
            
    For Each word In abbreviationList
        For Each rng In ActiveDocument.StoryRanges
            rng.Find.Text = word
            rng.Find.ClearFormatting
            rng.Find.Replacement.ClearFormatting
            rng.Find.Forward = True
            rng.Find.Replacement.Highlight = True
            rng.Find.Format = True
            rng.Find.MatchCase = True
            rng.Find.MatchWholeWord = True
            rng.Find.MatchWildcards = False
            rng.Find.MatchSoundsLike = False
            rng.Find.MatchAllWordForms = False
        
            Do While rng.Find.Execute
                rng.Select
                'from our selection point, work backwards.  If the first quote is a start quote,_
                'we are inside dialogue  If first quote I see is an end quote, we _
                'are outside the dialogue tag
                Do While Not (Selection.Characters(1) = Chr(147) Or Selection.Characters(1) = Chr(148) Or Selection.Characters(1) = Chr(134))
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Loop
                
                'Start quote = dialogue
                If Selection.Characters(1) = Chr(147) Then
                    rng.Select
                    Selection.Range.HighlightColorIndex = abbreviationColor
                End If
            Loop
        Next rng
    Next word

    ' Restore saved settings
    ActiveDocument.TrackRevisions = oldTrack
    ActiveDocument.Characters(1).Delete
    Options.DefaultHighlightColorIndex = oldHighlight
    Application.Run MacroName:="Replace_Smart_Quotes_With_Straight_Quotes"
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
End Sub

'Find sentences that indicate simultaneous actions - bright green
'Change to "He/She []ed ___ and ____" or "He/she []ed, ____"
'Won't work for present or future tense
Sub T_Find_Unsophisticated_Sentences()

On Error GoTo LocalError

    Application.Run MacroName:="Clear_All_Highlighting"
        
    'convert ellipses temporarily
    With ActiveDocument.Content.Find
        .Text = "..."
        .Replacement.Text = "…"
        .Execute Replace:=wdReplaceAll
    End With
    
    'convert question marks temporarily
    With ActiveDocument.Content.Find
        .Text = "?"
        .Replacement.Text = Chr(165)
        .Execute Replace:=wdReplaceAll
    End With
    
    Dim wordCtr As Integer
    Dim tmpWord As String
    Dim wordsInSentence
    Dim wordIdxCtr As Integer
    Dim pronouns
    Dim pronounFound As Boolean
    Dim pastTenseVerbs
    Dim isPastTenseVerb As Boolean
    tmpWord = ""
    pronounFound = False
    isPastTenseVerb = False
    
    pastTenseVerbs = Array("arose", "ate", "awoke", "beat", "became", "began", "bent", "bet", "bid", "bit", "blest", "blew", "bore", "bought", "broadcast", "broke", "brought", "built", "burnt", "came", "caught", "chose", "clapt", "cleft", "clept", "cost", "crept", "cut", "dealt", "did", "dove", "drank", "dreamt", "drest", "drew", "drove", "dug", "dwelt", "fell", "felt", "flew", "forgave", "forgot", "forsook", "found", "froze", "gave", "gilt", "girt", "got", "grew", "had", "heard", "held", "hid", "hit", "hung", "hurt", "kent", "kept", "knelt", "knew", "laid", "lay", "leant", "led", "left", "lent", "let", "lit", "lost", "made", "meant", "met", "paid", "pent", "put", "ran", "rang", "read", "reft", "rent", "rode", "rose", "said", "sang", "sank", "sat", "saw", "sent", "shone", "shook", "shot", "shrank", "shut", "slept", "slipt", "smelt", "snuck", "sold", "spelt", "spent", "split", "spoilt", "spoke", "sprang", "sprung", "stank", "stole", "stood", "stript", "strode", "strove", "stunk", "swam", "swore", _
        "taught", "thought", "threw", "told", "took", "tore", "tore", "understood", "vext", "walk", "went", "wept", "woke", "won", "wore", "wove", "wrote", "wrote")
    
    sPrompt = "Please enter any character names you wish to use (ex. 'John, Mike, Emily') or leave blank"
    sTitle = "Enter Character Names"
    sInput = InputBox(sPrompt, sTitle)
    names = Split(sInput, ",")
    blDimensioned = False
    
    If (UBound(names) > -1) Then
        For Each sName In names
            If blDimensioned = True Then
                ReDim Preserve pronouns(0 To UBound(pronouns) + 1) As String
            Else
                ReDim pronouns(0 To 0) As String
                blDimensioned = True
            End If
        
            pronouns(UBound(pronouns)) = sName
        Next sName
    
        ReDim Preserve pronouns(0 To UBound(pronouns) + 1) As String
        pronouns(UBound(pronouns)) = "it"
        ReDim Preserve pronouns(0 To UBound(pronouns) + 1) As String
        pronouns(UBound(pronouns)) = "he"
        ReDim Preserve pronouns(0 To UBound(pronouns) + 1) As String
        pronouns(UBound(pronouns)) = "she"
        ReDim Preserve pronouns(0 To UBound(pronouns) + 1) As String
        pronouns(UBound(pronouns)) = "I"
    Else
        pronouns = Array("he", "she", "it", "I")
    End If
    
    For Each mySentence In ActiveDocument.Sentences
        pronounFound = False
        isPastTenseVerb = False
        wordsInSentence = Split(mySentence)
        tmpWord = wordsInSentence(0)
        
        'First path: if the word ends with -ing
        If (Right(tmpWord, 3) = "ing") Then
            'MsgBox (mySentence)
            wordIdxCtr = 0
            wordsInSentence = Split(mySentence)
            Do While (wordIdxCtr < UBound(wordsInSentence))
                'See if there's a comma (that's not a quote ender)
                tmpWord = Trim(LCase(wordsInSentence(wordIdxCtr)))
                If (InStr(tmpWord, ",") > 0 And InStr(tmpWord, Chr(34)) < 1) Then
                    'See if phrase after the comma starts with he/she/it/or a name
                    wordIdxCtr = wordIdxCtr + 1
                    tmpWord = Trim(LCase(wordsInSentence(wordIdxCtr)))
                    For Each sPronoun In pronouns
                        If (tmpWord = Trim(LCase(sPronoun))) Then
                            pronounFound = True
                        End If
                    Next sPronoun
                    
                    If (pronounFound) Then
                        'If so, see if the word after it ends in 'ed'
                        wordIdxCtr = wordIdxCtr + 1
                        Do While (wordIdxCtr < UBound(wordsInSentence))
                            tmpWord = Trim(LCase(wordsInSentence(wordIdxCtr)))
                            
                            For Each sVerb In pastTenseVerbs
                                If (tmpWord = Trim(LCase(sVerb))) Then
                                    isPastTenseVerb = True
                                End If
                            Next sVerb
                            If (Len(tmpWord) > 2) Then
                                If (Mid(tmpWord, Len(tmpWord) - 1) = "ed" Or isPastTenseVerb) Then
                                    mySentence.Select
                                    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                                    Selection.Range.HighlightColorIndex = wdPink
                                    wordIdxCtr = UBound(wordsInSentence)
                                End If
                            End If
                            wordIdxCtr = wordIdxCtr + 1
                        Loop
                    End If
                End If
                wordIdxCtr = wordIdxCtr + 1
            Loop
        End If
                    
        'Second path: if sentence starts with "As"
        If (Trim(LCase(tmpWord)) = "as") Then
            'MsgBox (mySentence)
            wordIdxCtr = 1
            'Check if second word is a pronoun
            tmpWord = Trim(LCase(wordsInSentence(wordIdxCtr)))
            For Each sPronoun In pronouns
                If (tmpWord = Trim(LCase(sPronoun))) Then
                    pronounFound = True
                End If
            Next sPronoun
            
            If (pronounFound) Then
                'check if 3rd word (or next non-adverb word) is past tense verb
                wordIdxCtr = wordIdxCtr + 1
                            
                Do While (wordIdxCtr < UBound(wordsInSentence))
                    tmpWord = Trim(LCase(wordsInSentence(wordIdxCtr)))
                    For Each sVerb In pastTenseVerbs
                        If (InStr(tmpWord, Trim(LCase(sVerb))) > 0) Then
                            isPastTenseVerb = True
                        End If
                    Next sVerb
                    
                    If (Len(tmpWord) > 2) Then
                        If (Mid(tmpWord, Len(tmpWord) - 1) = "ed" Or isPastTenseVerb) Then
                            mySentence.Select
                            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                            Selection.Range.HighlightColorIndex = wdPink
                            wordIdxCtr = UBound(wordsInSentence) 'get out of while loop
                        End If
                    End If
                    wordIdxCtr = wordIdxCtr + 1
                Loop
            End If
        End If
    Next mySentence
    
    'convert ellipses back
    With ActiveDocument.Content.Find
        .Text = "…"
        .Replacement.Text = "..."
        .Execute Replace:=wdReplaceAll
    End With
    
    'convert question marks back
    With ActiveDocument.Content.Find
        .Text = Chr(165)
        .Replacement.Text = "?"
        .Execute Replace:=wdReplaceAll
    End With
    
    'Move cursor to beginning of document
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    
LocalError:
    Dim Msg As String
    If Err.Number <> 0 Then
        Msg = "Error # " & Err.Number & " - " & Err.Description
        MsgBox (Msg)
    End If
End Sub

Private Function removeCharacters(InString As String) As String
    Dim intLoopCounter As Integer
    Dim intStringLength As Integer
    Dim intASCIIVal As Integer
     
    intStringLength = Len(InString)
    InString = LCase(InString)

    For intLoopCounter = 1 To intStringLength
        intASCIIVal = Asc(Mid(InString, intLoopCounter, 1))
        If intASCIIVal >= 97 And intASCIIVal <= 122 Then
            removeCharacters = removeCharacters + Mid(InString, intLoopCounter, 1)
        End If
    Next intLoopCounter
     
End Function

Post a Comment