View Single Post
 
Old 06-27-2019, 01:12 PM
kilroy kilroy is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

Code wrap tags not working for me. I'm sure the pro's are shaking their head. Lol. It can probably be written much better but not by me.


Try this:


Sub TwoInitialsTwoLastNames()
Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = " ([A-Z]. [A-Z]. )([A-Z]{1}[a-z]{1,}-[A-Z]{1}[a-z]{1,})"
.Replacement.Text = " \2, \1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Selection.Find.Execute Replace:=wdReplaceAll
End With
Call OneInitialTwoLastNames
End Sub
Sub OneInitialTwoLastNames()
Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([A-Z]. )([A-Z]{1}[a-z]{1,}-[A-Z]{1}[a-z]{1,})"
.Replacement.Text = "\2, \1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Selection.Find.Execute Replace:=wdReplaceAll
End With
Call TwoInitialsOneLastName
End Sub
Sub TwoInitialsOneLastName()
Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([A-Z][. ]) ([A-Z][. ]) ([A-Z]{1}[a-z]{1,})"
.Replacement.Text = "\3, \1, \2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Selection.Find.Execute Replace:=wdReplaceAll
End With
Call OneInitialOneLastName
End Sub
Sub OneInitialOneLastName()
Selection.WholeStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([A-Z]. )([A-Z]{1}[a-z]{1,})"
.Replacement.Text = "\2, \1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
Selection.Find.Execute Replace:=wdReplaceAll
End With
End Sub
Reply With Quote