'**checks if selection spans and has changed to a different column in order
'**Adds a new column to the right of the selected active cell in order
'**to place new initials value and not overwrite other data
If Not colAdded Then
ActiveCell.EntireColumn.Offset(0, 1).Insert
colAdded = True
End If
fullName = Trim(cell.Value)
'**If comma is in name value then assumes last name is first
If InStr(fullName, ",") Then
lName = Left(fullName, InStr(fullName, ",") - 1)
fName = Trim(Mid(fullName, InStr(fullName, ",") + 1))
If InStr(fName, " ") Then
mName = Trim(Mid(fName, InStr(fName, " ") + 1))
fName = Left(fName, InStr(fName, " ") - 1)
Else
mName = mInitial
End If
'**Otherwise no comma and assumes first name is first
ElseIf InStr(fullName, " ") Then
fName = Left(fullName, InStr(fullName, " ") - 1)
lName = Trim(Mid(fullName, InStr(fullName, " ") + 1))
If InStr(lName, " ") Then
mName = Trim(Left(lName, InStr(lName, " ") - 1))
lName = Trim(Mid(lName, InStr(lName, " ") + 1))
Else
mName = mInitial
End If
End If
initials = Left(fName, 1) & Left(mName, 1) & Left(lName, 1)
ActiveCell.Cells.Offset(0, 1).Value = UCase(initials)
x = 0
'**The following 2 code lines are useful if your full name values are
'**in different formats and you would like to tidy things up
'**Uncommenting (removing the " ' " from) the following code will overwrite
'**highlighted name values with a standard convention of
'**[Last Name], [First Name] [Middle Name]
'ActiveCell.Value = StrConv(lName, vbProperCase) & ", " & StrConv(fName, vbProperCase) & _
IIf(mName = "_", "", " " & StrConv(mName, vbProperCase))
'**Uncommenting the following line will overwrite name values same as above but uses convention of
'**[First Name] [Middle Name] [Last Name] (only uncomment one or the other)
'ActiveCell.Value = StrConv(fName, vbProperCase) & IIf(mName = "_", " ", " " & _
StrConv(mName, vbProperCase) & " ") & StrConv(lName, vbProperCase)