INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Functions

Proper Case function to handle surnames - Another Take by CompuSolve
Posted: 16 Jun 06

Another take on getting the proper case - this will work for addresses, hyphenated names, full names, etc.  This does mulitple iterative calls to a sub function, so not the speediest function in the world but pretty flexible and handles alot of scenarios.

CODE

? pcase ("141 e.14 st., john o'brien-kelly-mcsmith way po box 131")
141 E.14 St., John O'Brien-Kelly-McSmith Way P.O. Box 131

Include the 2 functions below and make the call to the pcase function.

CODE

Public Function ProperCase(strIn As Variant, delimIn As String) As Variant

'delim in is a delimiter - anything to the right of the delimiter is capitalized
'the normal call should be with "" as the delimiter

Dim iLen
Dim vArr() As String
Dim strHold As String
Dim loopX As Integer

On Error GoTo properCase_Error

If IsNull(strIn) Then
   ProperCase = Null
   Exit Function
End If

If Trim(strIn) = "" Then
   ProperCase = Trim(strIn)
   Exit Function
End If

If delimIn = "" Then
   strIn = UCase(Left(strIn, 1)) & Mid(strIn, 2)
End If

vArr = Split(strIn, delimIn)

If UBound(vArr) > 0 Then
   For loopX = 1 To UBound(vArr)
      vArr(loopX) = Nz(ProperCase(vArr(loopX), ""), "")
      'vArr(loopX) = Trim(StrConv(vArr(loopX), vbProperCase))
   Next
End If

iLen = Len(vArr(0))
'check for MC
If Left(vArr(0), 2) = "MC" Then
   vArr(0) = "Mc" & UCase(Mid(vArr(0), 3, 1)) & Mid(vArr(0), 4)
End If

strHold = ""

If UBound(vArr) > 0 Then
   strHold = vArr(0)
   For loopX = 1 To UBound(vArr)
      strHold = strHold & delimIn & vArr(loopX)
   Next
Else
   strHold = vArr(0)
End If

If strHold = "" Then
   ProperCase = Null
Else
   ProperCase = strHold
End If

properCase_Exit:
Exit Function

properCase_Error:
MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & Error$, vbExclamation, "Entry1 - ProCas"
ProperCase = strIn
Resume properCase_Exit
Resume
End Function

Public Function PCase(strIn As Variant) As Variant

On Error GoTo properCaseMain_Error

Dim strHold As Variant

'do an initial strconv - this will capitalize the first letter of each word in the string
'a word is any group of letters seperated by a space
strHold = Trim(StrConv(strIn, vbProperCase))

'remove any duplicate spaces from the string
While InStr(strHold, "  ") > 0
   strHold = Replace(strHold, "  ", " ")
Wend

'capitalize the letter after any occurence of '-'
If InStr(1, strHold, "-") > 0 Then
   strHold = ProperCase(strHold, "-")
End If

'capitalize the letter after any occurence of '.'
If InStr(1, strHold, ".") > 0 Then
   strHold = ProperCase(strHold, ".")
End If

'capitalize the letter after any occurence of '''
If InStr(1, strHold, "'") > 0 Then
   strHold = ProperCase(strHold, "'")
End If

'capitalize the letter after any occurence of ' '
'this is done for normal words with the initial strconv, but run this
'to pick up special cases, such as embedded mcdonald - "JIM MCDONALD"
If InStr(1, strHold, " ") > 0 Then
   strHold = ProperCase(strHold, " ")
End If

'any other delimiters that need to be checked can be placed here
'using the format above

'any special replacements can be placed here - they will be done after everything else
strHold = Replace(strHold, "p.o.box", "P.O. Box")
strHold = Replace(strHold, "po box", "P.O. Box")
strHold = Replace(strHold, "p o Box", "P.O. Box")
strHold = Replace(strHold, "post office box", "P.O. Box")

PCase = strHold

properCaseMain_Exit:
Exit Function

properCaseMain_Error:
MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & Error$, vbExclamation, "Entry1 - ProCasMai"
PCase = strIn
Resume properCaseMain_Exit

End Function

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close