Moving words within a text - vba

Question

I am trying to create two keyboard shortcuts which allow me to move selected words quickly to the right and left within a text. The selected text should move one word to the left or the right.
Here is what I want to do
1) Select words e.g. “this is” in the sentence “this is a tree”
2) Press e.g. ctrl + alt + arrow to the right
3) The sentence reads now as “a this is tree”
4) Press again ctrl alt + arrow to the right
5) The sentence reads now as “a tree this is”
The idea is to replace the cut / paste steps and make the process a bit more efficient and smoother.
I have no knowledge in VB, but managed to get close to by using Word’s macro-function.
Sub moveRight()
'moveRight Macro
Selection.Cut
Selection.moveRight Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub
The problem with this function is that the selected words are no longer selected once they are pasted. Hence, triggering the function again (=moving the text more than one word) results in an error (I would have to select the relevant text again). Is there any way that the selected words remain selected after they are pasted so that I can trigger the function repeatedly?
Many thanks.

Answer 1

You might like to try this solution. The first two procedures below should be called by your keyboard shortcuts. The both call the same executing sub, but with different parameters.
Sub MoveSelectionLeft()
' call with keyboard shortcut
GetSelection True
End Sub
Sub MoveSelectionRight()
' call with keyboard shortcut
GetSelection False
End Sub
Private Sub GetSelection(ByVal ToLeft As Boolean)
' 22 Apr 2017
Dim Rng As Range
Dim SelTxt As String ' selected text (trimmed)
Dim Sp() As String
Set Rng = Selection.Range
With Rng
SelTxt = Trim(.Text)
If ToLeft Then
.MoveStart wdWord, -1
Else
.MoveEnd wdWord, 1
End If
Sp = Split(Trim(.Text))
If ToLeft Then
.Text = SelTxt & " " & Sp(0) & " "
Else
.Text = Sp(UBound(Sp)) & " " & SelTxt & " "
End If
.Find.Execute SelTxt
.Select
End With
End Sub

Answer 2

A cheap way of doing this is with bookmarks. At some point before and after moving the text, run AddBookMark and DeleteBookMark respectively.
Public Sub AddBookMark()
Dim myDocument As Document
Set myDocument = ActiveDocument
myDocument.Bookmarks.Add "MySelectedText", Selection
End Sub
Public Sub DeleteBookMark()
Dim myDocument As Document
Set myDocument = ActiveDocument
myDocument.Bookmarks("MySelectedText").Delete
End Sub
Sub moveRight()
Dim myDocument As Document
Set myDocument = ActiveDocument
Selection.Cut
Selection.moveRight Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
myDocument.Bookmarks("MySelectedText").Select
End Sub