User Defined Functions to separate full names

[DZ]

Hi

I want to create three user defined functions
1. FirstName
2. MiddleInitial
3. LastName

so that a user can use them by selecting the function(s) from the Paste
Function Dialog and then simply selecting a cell reference that contains the
full name.

I already know how to create the function arguments as follows

Function FirstName (FulNameCell as range)
Code----------------------
End Function

I need the complete code to get the first name etc

Also

Function Middleinitial (FulNameCell as range)
Code----------------------
End Function

Function LastName (FulNameCell as range)
Code----------------------
End Function

Thanks alot for help with this.

DZ

 

[Gary''s Student]

Function FirstName(FulNameCell As Range)
FirstName = Split(FulNameCell.Value, " ")(0)
End Function

Function Middleinitial(FulNameCell As Range)
Middleinitial = Split(FulNameCell.Value, " ")(1)
End Function

Function LastName(FulNameCell As Range)
LastName = Split(FulNameCell.Value, " ")(2)
End Function

 

[Bob Phillips]

Function FirstName(FulNameCell As Range)
FirstName = Left$(FulNameCell, InStr(FulNameCell, " ") - 1)
End Function


Function Middleinitial(FulNameCell As Range)
Dim First As Long
Middleinitial = ""
If Len(FulNameCell) - Len(Replace(FulNameCell, " ", "")) = 2 Then

First = InStr(FulNameCell, " ")
Middleinitial = Mid$(FulNameCell, First + 1, InStr(First + 1,
FulNameCell, " ") - First)
End If

End Function

Function LastName(FulNameCell As Range)
LastName = Right$(FulNameCell, Len(FulNameCell) - InStrRev(FulNameCell,
" "))
End Function



--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Ron Rosenfeld]

Hi

I want to create three user defined functions
1. FirstName
2. MiddleInitial
3. LastName

so that a user can use them by selecting the function(s) from the Paste
Function Dialog and then simply selecting a cell reference that contains the
full name.

I already know how to create the function arguments as follows

Function FirstName (FulNameCell as range)
Code----------------------
End Function

I need the complete code to get the first name etc

Also

Function Middleinitial (FulNameCell as range)
Code----------------------
End Function

Function LastName (FulNameCell as range)
Code----------------------
End Function

Thanks alot for help with this.

DZ

Here's something that might get you started:

======================================
Option Explicit
Function FirstName(FulNameCell As Range)
FirstName = ParseName(FulNameCell.Value, 0)
End Function
'------------------------------------
Function Middleinitial(FulNameCell As Range)
Middleinitial = ParseName(FulNameCell.Value, 2)
End Function
'------------------------------------
Function LastName(FulNameCell As Range)
LastName = ParseName(FulNameCell.Value, 3)
End Function
'----------------------------------------
Function ParseName(str As String, Part As Long) As String
'Part: 0 = First Name
' 1 = Middle Name
' 2 = Middle Initial
' 3 = Last Name
Dim re As Object, mc As Object, m As Object
Dim i As Long
Set re = CreateObject("vbscript.regexp")
re.Pattern = "^(\S+)\s?((\S?).*)\s(\S+)$"
If re.test(str) Then
Set mc = re.Execute(str)
ParseName = mc(0).submatches(Part)
End If
End Function
===================================================
--ron

 

[Per Jessen]

Hi

I want to create three user defined functions
1. FirstName
2. MiddleInitial
3. LastName

so that a user can use them by selecting the function(s) from the Paste
Function Dialog and then simply selecting a cell reference that contains the
full name.

I already know how to create the function arguments as follows

Function FirstName (FulNameCell as range)
Code----------------------
End Function

I need the complete code to get the first name etc

Also

Function Middleinitial (FulNameCell as range)
Code----------------------
End Function

Function LastName (FulNameCell as range)
Code----------------------
End Function

Thanks alot for help with this.

DZ

Hi

This should do it:

Function FirstName(FulNameCell As Range)
FullName = FulNameCell
For c = 1 To Len(FullName)
If Mid(FullName, c, 1) = " " Then
FnLen = c - 1
Exit For
End If
Next
FirstName = Left(FullName, FnLen)
End Function
Function LastName(FulNameCell As Range)
For c = Len(FulNameCell) To 1 Step -1
If Mid(FulNameCell, c, 1) = " " Then
FnLen = c
Exit For
End If
Next
LastName = Right(FulNameCell, Len(FulNameCell) - FnLen)

End Function


Function MiddleInitial(FulNameCell As Range)
For c = 1 To Len(FulNameCell)
If Mid(FulNameCell, c, 1) = " " Then
FnLen = c + 1
Exit For
End If
Next
For c = FnLen To Len(FulNameCell)
If Mid(FulNameCell, c, 1) = " " Then
FnMid = c - FnLen
Exit For
End If
Next
MiddleInitial = Mid(FulNameCell, FnLen, FnMid)
End Function

Regards,
Per