Transpose Characters

There is no function in Word to transpose the order of two characters - a function that has been available in some word processing software since before Windows found its way onto the home computer. The following macro attached to some suitable keyboard shortcut will correct that omission. The macro works with either two selected characters or the characters either side of the cursor. The macro also takes account of the case of the transposed characters. If the first character to be transposed is upper case and the second not, then after transposition the first character will be upper case and the second lower case. Where both or neither characters are upper case, the case of the characters is retained.

Sub Transpose() Dim oRng As Range Dim sText As String Dim Msg1 As String Dim Msg2 As String Dim Msg3 As String Dim MsgTitle As String Msg1 = "You must place the cursor between " & _ "the 2 characters to be transposed!" Msg2 = "There are no characters to transpose?" Msg3 = "There is no document open!" MsgTitle = "Transpose Characters" On Error GoTo ErrorHandler If ActiveDocument.Characters.Count > 2 Then      Set oRng = Selection.Range      Select Case Len(oRng)      Case Is = 0           If oRng.Start = oRng.Paragraphs(1).Range.Start Then                MsgBox Msg1, vbCritical, MsgTitle                Exit Sub           End If           If oRng.End = oRng.Paragraphs(1).Range.End - 1 Then                MsgBox Msg1, vbCritical, MsgTitle                Exit Sub           End If           With oRng                .Start = .Start - 1                .End = .End + 1                .Select                sText = .Text           End With      Case Is = 1           MsgBox Msg1, vbCritical, MsgTitle           Exit Sub      Case Is = 2           sText = Selection.Range.Text      Case Else           MsgBox Msg1, vbCritical, MsgTitle           Exit Sub      End Select      With Selection           If .Range.Characters(1).Case = 1 _           And .Range.Characters(2).Case = 0 Then                .Text = UCase(Mid(sText, 2, 1)) & _                LCase(Mid(sText, 1, 1))           Else                .Text = Mid(sText, 2, 1) & _                Mid(sText, 1, 1)           End If           .Collapse wdCollapseEnd           .Move wdCharacter, -1      End With Else      MsgBox Msg2, vbCritical, MsgTitle End If ErrorHandler: If Err.Number = 4248 Then MsgBox Msg3, vbCritical, MsgTitle End If End Sub