Military Name Format code

tbird

Board Regular
Joined
Oct 21, 2002
Messages
184
Hi everyone! This post is informational in the spirit of giving back to the community from which I have received help. With a lot of coding help from experts on this board (Thanks to Jimboy, Andrew Poulsom, & Barrie Davidson), I have collected the necessary code to convert a column of names(first, middle, last) to U. S. Military format (Last, first, middle) and back again. The usefulness for me is to enable automatic sorting by last name. This code allows you to select the 1st cell in the list instead of the entire list before initiating the macro. There are two sets of code below. . I activate the code with two separate tool buttons to let me perform the sort operation in the middle and also clean up any glitches. Of necessity (for me), the code was recorded/copied into separate subroutines. Someone with more experience can probably condense this into fewer lines.
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
ABCDE
1InitialNamesAddressesCityPhonenumbersZipcode
2TomSmyth1234statestDetroit555-121212345
3FredE.Brown1235statestDetroit555-121312346
4JohnSmith1236statestDetroit555-121412347
5M.A.Blond1237statestDetroit555-121512348
6A.Green1238statestDetroit555-121612349
Original
PERSONAL.XLS
ABCDE
1InitialNamesAddressesCityPhonenumbersZipcode
2Smyth,Tom1234statestDetroit555-121212345
3Brown,FredE.1235statestDetroit555-121312346
4Smith,John1236statestDetroit555-121412347
5Blond,M.A.1237statestDetroit555-121512348
6Green,A.1238statestDetroit555-121612349
Military Names
PERSONAL.XLS
ABCDE
1InitialNamesAddressesCityPhonenumbersZipcode
2TomSmyth1234statestDetroit555-121212345
3M.A.Blond1237statestDetroit555-121512348
4FredE.Brown1235statestDetroit555-121312346
5A.Green1238statestDetroit555-121612349
6JohnSmith1236statestDetroit555-121412347
Final Sorted
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,896
Messages
5,766,992
Members
425,392
Latest member
Booknerd

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top