Sub TrueTitleCase() ' ' TrueTitleCase Macro ' ' ' Replaces Word's built-in title case with a ' version which does not capitalise certain words Dim myRange As Range Dim wd As Range Dim x As Integer x = 0 Set myRange = Selection.Range If myRange.Start = myRange.End Then x = myRange.Start myRange.Expand End If 'myRange.Case = wdTitleSentence For Each wd In myRange.Words Select Case Trim(wd) ' the following group of words will be left ' unchanged Case "the", "and", "for", "of", "a", "an", _ "as", "to", "about", "from", "in", "on", "or", _ "under", "against", "at", "into", "over", "but", "with", "before", "versus" ' the following groups of words will be ' changed to lower case Case "The", "And", "For", "Of", "A", "An", _ "As", "To", "From", "Versus", "In", "On", "Or", _ "Under", "Against", "At", "Into", "With", "Over", "Before", "But", "About", _ "THE", "AND", "FOR", "OF", "A", "AN", "OR", _ "AS", "TO", "FROM", "VERSUS", "IN", "ON", _ "UNDER", "AGAINST", "AT", "WITH", "OVER", "INTO", "BEFORE", "BUT", "ABOUT" wd.Case = wdLowerCase Case Else ' Any word that isn't in either of the above groups ' will be changed to title case, i.e. initial cap wd.Case = wdTitleWord End Select Next wd If myRange.Words.Count > 1 Then myRange.Words(1).Case = wdTitleWord End If If x <> 0 Then Selection.Start = x Selection.End = x End If End Sub