VBA gedöns (Excel Cell Content Swap)

'coded by v2.01 UEZ build 2014-05-26
Sub Swap_Coordinate2()
    Dim Cells As Range
    Dim Result As Variant
    For Each Cells In Application.selection
        If Cells.Value <> "" Then
            Result = SwapIt(Cells.Value, Cells.Row, Cells.Column)
            If Result <> "" Then
                'MsgBox ("*" & Result & "*")
                Cells.Value = Result
            End If
        End If
    Next Cells
    Set Cells = Nothing
End Sub


Function SwapIt(sString As String, iRow As Integer, iCol As Integer) As Variant
    Dim RegEx As Object
    Dim oResult As Object
    Dim tokens As Variant
    Dim sSwapped As Variant

    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Pattern = "(.+)\S"
    RegEx.Global = True
    RegEx.IgnoreCase = True
    RegEx.MultiLine = True

    Set oResult = RegEx.Execute(sString)

    For Each tokens In oResult
        sSwapped = sSwapped & RegExSwap(tokens.Value, iRow, iCol) & vbCrLf
    Next
    If sSwapped <> "" Then
        SwapIt = Left(sSwapped, Len(sSwapped) - 2)
    Else
        MsgBox ("Error: unable to swap coordinates at " & iRow & ":" & iCol & " (x:y)! Please swap coordinates manually if applicable!")
    End If
    Set RegEx = Nothing
    Set oResult = Nothing
End Function


Function RegExSwap(sText As Variant, iY As Integer, iX As Integer) As Variant

    Dim RegExResult As String
    Dim allMatches As Object
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")

    RegEx.Pattern = "(.+) to (.+) (free.*)"
    RegEx.Global = True
    RegEx.IgnoreCase = True
    Set allMatches = RegEx.Execute(sText)

    Select Case allMatches.Count
        Case 1
            RegExResult = allMatches.Item(0).SubMatches.Item(1) & " to " & allMatches.Item(0).SubMatches.Item(0) & " " & allMatches.Item(0).SubMatches.Item(2)
        Case Else
            RegEx.Pattern = "(.+) to (.+)"
            Set allMatches = RegEx.Execute(sText)
            If allMatches.Count = 1 Then
                RegExResult = allMatches.Item(0).SubMatches.Item(1) & " to " & allMatches.Item(0).SubMatches.Item(0)
            Else
                RegExResult = sText
            End If
    End Select

    Set allMatches = Nothing
    Set RegEx = Nothing
    RegExSwap = RegExResult
End Function