Note that this code inserts four columns to the right of the column of names and then deletes them leaving the other data in the spreadsheet intact. In addition, it also only works on contiguous cells in the column, so if there is a gap; it will not touch anything below the gap. In the pasted screenshots, the first is the original data, the second is the data with names in military format, and the third is the final with data sorted alphabetically by last name and the names converted back.

Military Name Conversion Code:

Code:

```
'Dim c As Range
'Dim mylast
'Dim newlast
Public firstcell As Range
Sub FourColInsrt()
'
' FourColInsrt Macro
'
ActiveCell.Offset(0, 1).Select
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
'
ActiveCell.Offset(0, -1).Select
Set firstcell = Range(ActiveCell.Address)
Call LNFormulaInsrt
End Sub
Sub LNFormulaInsrt()
'
' LNFormulaInsrt Macro
'
' mylast = Cells.SpecialCells(xlLastCell).Row - ActiveCell.Row
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 1).Formula = "=RIGHT(RC[-1],LEN(RC[-1])-FIND(""*"",SUBSTITUTE(RC[-1],"" "",""*"",LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],"" "","""")))))"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 1).Formula = "=RIGHT(RC[-1],LEN(RC[-1])-FIND(""*"",SUBSTITUTE(RC[-1],"" "",""*"",LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],"" "","""")))))"
' End If
' Next c
firstcell.Select
Call FNFormulaInsrt
End Sub
Sub FNFormulaInsrt()
'
' FNFormulaInsrt Macro
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 2).Formula = "=LEFT(RC[-2],FIND("" "",RC[-2])-1)"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 2).Formula = "=LEFT(RC[-2],FIND("" "",RC[-2])-1)"
' End If
' Next c
firstcell.Select
Call MIFormulaInsrt
End Sub
Sub MIFormulaInsrt()
'
' Formula3Insrt Macro
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 3).Formula = "=IF(ISERR(MID(RC[-3],FIND("" "",RC[-3])+1,IF(ISERR(FIND("" "",RC[-3],FIND("" "",RC[-3])+1)),FIND("" "",RC[-3]),FIND("" "",RC[-3],FIND("" "",RC[-3])+1))-FIND("" "",RC[-3])-1)),"""",MID(RC[-3],FIND("" "",RC[-3])+ 1,IF(ISERR(FIND("" "",RC[-3],FIND("" "",RC[-3])+1)),FIND("" "",RC[-3]),FIND("" "",RC[-3],FIND("" "",RC[-3])+1))-FIND("" "",RC[-3])-1))"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 3).Formula = "=IF(ISERR(MID(RC[-3],FIND("" "",RC[-3])+1,IF(ISERR(FIND("" "",RC[-3],FIND("" "",RC[-3])+1)),FIND("" "",RC[-3]),FIND("" "",RC[-3],FIND("" "",RC[-3])+1))-FIND("" "",RC[-3])-1)),"""",MID(RC[-3],FIND("" "",RC[-3])+ 1,IF(ISERR(FIND("" "",RC[-3],FIND("" "",RC[-3])+1)),FIND("" "",RC[-3]),FIND("" "",RC[-3],FIND("" "",RC[-3])+1))-FIND("" "",RC[-3])-1))"
' End If
' Next c
firstcell.Select
Call ConcatFormulaInsrt
End Sub
Sub ConcatFormulaInsrt()
'
' ConcatFormulaInsrt Macro
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 4).Formula = "=CONCATENATE(RC[-3],"","","" "",RC[-2],"" "",RC[-1])"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 4).Formula = "=CONCATENATE(RC[-3],"","","" "",RC[-2],"" "",RC[-1])"
' End If
' Next c
firstcell.Select
Call ColClnup
End Sub
Sub ColClnup()
' ColClnup Macro
'
Range(Cells(ActiveCell.Row, ActiveCell.Column + 4), Cells(65536, ActiveCell.Column + 4).End(xlUp)).Copy
Selection.PasteSpecial paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveCell.Offset(0, 1).Resize(1, 4).EntireColumn.Delete
End Sub
```

The following code reverses the process and restores the names in the original order.

Code:

```
'Dim c As Range
'Dim mylast
'Dim newlast
Public firstcell As Range
Sub RMNFourColInsrt()
'
ActiveCell.Offset(0, 1).Select
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
'
ActiveCell.Offset(0, -1).Select
Set firstcell = Range(ActiveCell.Address)
Call RMNFNInsrt
End Sub
Sub RMNFNInsrt()
'
' mylast = Cells.SpecialCells(xlLastCell).Row - ActiveCell.Row
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 1).Formula = "=IF(ISERR(MID(RC[-1],FIND("" "",RC[-1])+1,IF(ISERR(FIND("" "",RC[-1],FIND("" "",RC[-1])+1)), FIND("" "",RC[-1]),FIND("" "",RC[-1],FIND("" "",RC[-1])+1))-FIND("" "",RC[-1])-1)),"""",MID(RC[-1],FIND("" "",RC[-1])+ 1,IF(ISERR(FIND("" "",RC[-1],FIND("" "",RC[-1])+1)),FIND("" "",RC[-1]),FIND("" "",RC[-1],FIND("" "",RC[-1])+1))-FIND("" "",RC[-1])-1))"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 1).Formula = "=IF(ISERR(MID(RC[-1],FIND("" "",RC[-1])+1,IF(ISERR(FIND("" "",RC[-1],FIND("" "",RC[-1])+1)), FIND("" "",RC[-1]),FIND("" "",RC[-1],FIND("" "",RC[-1])+1))-FIND("" "",RC[-1])-1)),"""",MID(RC[-1],FIND("" "",RC[-1])+ 1,IF(ISERR(FIND("" "",RC[-1],FIND("" "",RC[-1])+1)),FIND("" "",RC[-1]),FIND("" "",RC[-1],FIND("" "",RC[-1])+1))-FIND("" "",RC[-1])-1))"
' End If
' Next c
firstcell.Select
Call RMNLNInsrt
End Sub
Sub RMNLNInsrt()
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 2).Formula = "=LEFT(RC[-2],FIND("" "",RC[-2])-2)"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 2).Formula = "=LEFT(RC[-2],FIND("" "",RC[-2])-2)"
' End If
' Next c
firstcell.Select
Call RMNMNInsrt
End Sub
Sub RMNMNInsrt()
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 3).Formula = "=RIGHT(RC[-3],LEN(RC[-3])-FIND(""*"",SUBSTITUTE(RC[-3],"" "",""*"",LEN(RC[-3])-LEN(SUBSTITUTE(RC[-3],"" "","""")))))"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 3).Formula = "=RIGHT(RC[-3],LEN(RC[-3])-FIND(""*"",SUBSTITUTE(RC[-3],"" "",""*"",LEN(RC[-3])-LEN(SUBSTITUTE(RC[-3],"" "","""")))))"
' End If
' Next c
firstcell.Select
Call RMNConcatFormulaInsrt
End Sub
Sub RMNConcatFormulaInsrt()
'
' ConcatFormulaInsrt Macro
'
Do While ActiveCell.Value<> Empty
ActiveCell.Offset(0, 4).Formula = "=CONCATENATE(RC[-3],"" "",RC[-1],"" "",RC[-2])"
ActiveCell.Offset(1, 0).Select
Loop
' For Each c In Range(ActiveCell.Address, Range(ActiveCell.Offset(mylast, 0).Address))
' If c.Value<> Empty Then
' c.Offset(0, 4).Formula = "=CONCATENATE(RC[-3],"" "",RC[-1],"" "",RC[-2])"
' End If
' Next c
firstcell.Select
Call ColClnup
End Sub
Sub ColClnup()
' ColClnup Macro
'
Range(Cells(ActiveCell.Row, ActiveCell.Column + 4), Cells(65536, ActiveCell.Column + 4).End(xlUp)).Copy
Selection.PasteSpecial paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveCell.Offset(0, 1).Resize(1, 4).EntireColumn.Delete
End Sub
```

PERSONAL.XLS | |||||||
---|---|---|---|---|---|---|---|

A | B | C | D | E | |||

1 | InitialNames | Addresses | City | Phonenumbers | Zipcode | ||

2 | TomSmyth | 1234statest | Detroit | 555-1212 | 12345 | ||

3 | FredE.Brown | 1235statest | Detroit | 555-1213 | 12346 | ||

4 | JohnSmith | 1236statest | Detroit | 555-1214 | 12347 | ||

5 | M.A.Blond | 1237statest | Detroit | 555-1215 | 12348 | ||

6 | A.Green | 1238statest | Detroit | 555-1216 | 12349 | ||

Original |

PERSONAL.XLS | |||||||
---|---|---|---|---|---|---|---|

A | B | C | D | E | |||

1 | InitialNames | Addresses | City | Phonenumbers | Zipcode | ||

2 | Smyth,Tom | 1234statest | Detroit | 555-1212 | 12345 | ||

3 | Brown,FredE. | 1235statest | Detroit | 555-1213 | 12346 | ||

4 | Smith,John | 1236statest | Detroit | 555-1214 | 12347 | ||

5 | Blond,M.A. | 1237statest | Detroit | 555-1215 | 12348 | ||

6 | Green,A. | 1238statest | Detroit | 555-1216 | 12349 | ||

Military Names |

PERSONAL.XLS | |||||||
---|---|---|---|---|---|---|---|

A | B | C | D | E | |||

1 | InitialNames | Addresses | City | Phonenumbers | Zipcode | ||

2 | TomSmyth | 1234statest | Detroit | 555-1212 | 12345 | ||

3 | M.A.Blond | 1237statest | Detroit | 555-1215 | 12348 | ||

4 | FredE.Brown | 1235statest | Detroit | 555-1213 | 12346 | ||

5 | A.Green | 1238statest | Detroit | 555-1216 | 12349 | ||

6 | JohnSmith | 1236statest | Detroit | 555-1214 | 12347 | ||

Final Sorted |