Sub LastWordSort() Set bkstrange = Selection.Range For Each p In bkstrange.Paragraphs p.Range.Select Selection.EndKey Unit:=wdLine Selection.MoveLeft Unit:=wdWord, Count:=1 Selection.TypeText Text:=vbTab Next p bkstrange.Select Selection.Sort FieldNumber:="Field 2" With Selection.Find .Text = "^t" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With End Sub