VBA Replace string order

by GarciaPL on Sunday 28 July 2013

I would like to share with you a small VBA macro which basic functionality is just replace order of two-member string for example :

John Travolta   ->   Travolta John

Short manual of macro :
1. Select cells you want to replace the order of their content
2. Run macro

Macro code :

Public Function StrRange(ByVal nRow As Single, ByVal nCol As Single) As String
        Dim sC As String
        Dim nC, nRest, nDivRes As Integer
       
        sC = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        nC = Len(sC)
       
        nRest = nCol Mod nC
        nDivRes = (nCol - nRest) / nC
       
        If nDivRes > 0 Then StrRange = Mid(sC, nDivRes, 1)
        StrRange = StrRange & Mid(sC, nRest, 1) & Format(nRow)
End Function
 
Sub ChangeString()
 
    Dim range As String
    range = Selection.Address(ReferenceStyle:=xlA1, _
                           RowAbsolute:=False, ColumnAbsolute:=False)
     
    If range = "" Then
        MsgBox ("The range of cells was not definedcells. Ending the macro")
        Exit Sub
    End If
   
    Dim Start
    Dim Last
    intPos = InStr(1, range, ":")
    If intPos > 0 Then
        split_string = Split(range, ":")
        If UBound(split_string) = 1 Then
            Start = split_string(0)
            Last = split_string(1)
        End If
    Else
        Start = range
        Last = Start
    End If
   
    Dim SheetName
    SheetName = ActiveSheet.Name
    If SheetName = "" Then
        MsgBox ("Cannot read sheet name. Ending the macro")
        Exit Sub
    End If
   
    Dim CellAddress
    For Each c In Range("" & CStr(Start) & ":" & "" & CStr(Last))
        If c.Value <> "" Then
            CellContent = Split(c.Value, " ")
            CellAddress = StrRange(c.Row, c.Column)
 
            Dim wb As Workbook
            Dim ws As Worksheet
            Dim TxtRng  As Range
            Set wb = ActiveWorkbook
 
            Set ws = wb.Sheets(SheetName)
            Set TxtRng = ws.Range("" & CStr(CellAddress))
            TxtRng.Value = CStr(CellContent(1)) & " " & CStr(CellContent(0))
        End If
    Next c
       
End Sub

Reference :
[1] Pastebin GarciaPL VBA Replace string order