Author of this module: David McAfee at dmcafee@pacbell.net
-----------------------------------------
Option Compare Database
Option Explicit
Function fProperCase(Optional strText As String, Optional blPrompt As Boolean) As String
'Call this function in this manner:
' ProperCase(yourTexthere)
' If you would like to be prompter on 2 or 3 character words, then call in this manner:
' ProperCase(yourTexthere,1)
'If any improvements/clean up/errors found in this code, please
'email David McAfee at dmcafee@pacbell.net
If Nz(strText, "") <> "" Then 'If value is not blank, then continue below
Dim intCounter As Integer
Dim OneChar As String
Dim StartingNumber As Integer
StartingNumber = 1
'*********************** 3 Letter Check
If Right(Left(strText, 4), 1) = " " Then 'Check for 3 character words at the start of string
'The line below checks for all 3 characters to be equal, and capitalize if so "AAA" or "EEE Movers"
'The next line, prompts the user if they would like to capaitalize the 3 letter word, this can be replaced
'with something like: If Left(strText,3) IN ("ADP", "TMT") or like: If Left(strText,3) NOT IN ("Joe", "Bob")
'If you'd rather not prompt the user
If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText, 1) = Mid$(strText, 3, 1)) Or _
(blPrompt = True And AskToConvert(strText, Left(strText, 3), 3, blPrompt) = 6) Then
'Capitalize the 3 char's
strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText, 4, 255))
StartingNumber = 4
Else
'Only capitalize the first of the 3 char's
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
StartingNumber = 2
End If
'******************** End 3 letter check
'******************** Start 2 Letter word check
ElseIf Right(Left(strText, 3), 1) = " " Then 'Check for 2 character words as the start of the string
If Left(strText, 1) = Mid$(strText, 2, 1) Or _
(blPrompt = True And AskToConvert(strText, Left(strText, 2), 2, blPrompt) = 6) Then
'Capitalize the 2 char's
strText = UCase(Left$(strText, 2)) & LCase$(Mid$(strText, 3, 255))
StartingNumber = 3
Else
'Only capitalize the first of the 2 char's
strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
StartingNumber = 2
End If
'***************** End 2 Letter Check
Else
'Convert first character to capital then the rest to lowercase.
strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
StartingNumber = 2
End If
'Look at each character, starting at the second character.
For intCounter = StartingNumber To Len(strText)
OneChar = Mid$(strText, intCounter, 1)
Select Case OneChar
'...convert the character after dash/hyphen/slash/period/ampersand to uppercase.
' Such as "A.B.C. Industries", B&B Mfg
Case "-", "/", ".", "&"
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Case "'" 'Check the character two places after the apostrophe.
If Mid$(strText, intCounter + 2, 1) <> " " Then 'If it is not a space, then capatilize (O'Conner, O'Niel)
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
Else
'Do nothing as in "Don't" , "Tom's Diner", "haven't", "I'm"
End If
Case "c" ' Take care of the McAfee's, McDonalds & McLaughlins and such
If (Mid$(strText, intCounter - 1, 1) = "M") Then 'Check if Prev Char is an M
If ((intCounter - 2) < 1) Then 'Check to see if the M was the first character
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
ElseIf (Mid$(strText, intCounter - 2, 1) = " ") Then
'If M wasn't first character, then check to see if a space was before the M, so we don't capitalize Tomchek or Adamczyk
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
End If
Case " "
Select Case Mid$(strText, intCounter + 1, 3)
Case "de " 'Add any other exceptions here Example: Oscar de La Hoya"
strText = Left$(strText, intCounter) & LCase$(Mid$(strText, intCounter + 1, 3)) & Mid$(strText, intCounter + 4, 255)
intCounter = intCounter + 3
Case Else ' Example: A B C Manufacturing
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End Select
If Mid$(strText, intCounter + 1, 9) = "diMartini" Then 'Add any other odd balls in this fashion
strText = Left$(strText, intCounter) & "diMartini" & Mid$(strText, intCounter + 10, 255)
End If
'*********************** Check for 3 character word *******************
If Mid$(strText, intCounter + 4, 1) = " " Then 'Check for 3 letter words
If (Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 2, 1) And _
Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 3, 1)) Or _
(blPrompt = True And AskToConvert(strText, Mid$(strText, intCounter + 1, 3), 3, blPrompt) = 6) Then
'Capitalize the 3 char's
strText = Left$(strText, intCounter) & UCase(Mid$(strText, intCounter + 1, 3)) & Mid$(strText, intCounter + 4, 255)
intCounter = intCounter + 3
Else
'Only capitalize the first of the 3 char's
strText = Left$(strText, intCounter) & UCase$(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
End If
'********************** check for 2 char words *******************
ElseIf Mid(strText, intCounter + 3, 1) = " " Then 'Check for 2 letter words
If (Mid(strText, intCounter + 1, 1) = Mid(strText, intCounter + 2, 1)) Or _
(blPrompt = True And AskToConvert(strText, Mid(strText, intCounter + 1, 2), 2, blPrompt) = 6) Then
'Capitalize the 2 char's
strText = Left$(strText, intCounter) & UCase(Mid(strText, intCounter + 1, 2)) & LCase$(Mid$(strText, intCounter + 3, 255))
intCounter = intCounter + 2
Else
'Only capitalize the first of the 2 char's
strText = Left$(strText, intCounter) & UCase(Mid$(strText, intCounter + 1, 1)) & Mid$(strText, intCounter + 2, 255)
intCounter = intCounter + 1
End If
'******************** END 2 LETTER CHECK
End If
Case Else
End Select
Next
Else
strText = ""
End If
'All done, return current contents of strText variable.
fProperCase = strText
End Function
Private Function AskToConvert(strWholeText As String, strSelection As String, NumOfChars As Integer, blPrompt As Boolean) As Integer
Dim txtNumChars As String
Dim Msg As String
Dim MsgBoxType As Integer
If blPrompt = True Then
MsgBoxType = 4
Select Case NumOfChars
Case 2
Msg = "In the example '" & strWholeText & "', shall I capitalize the two letter word '" & strSelection & "' to '" & UCase(strSelection) & "' ?"
Case 3
Msg = "In the example '" & strWholeText & "', shall I capitalize the three letter word '" & strSelection & "' to '" & UCase(strSelection) & "' ?"
Case Else
Msg = "Developer called Function AskToConvert from Function ProperCase but did not specify NumOfChars"
MsgBoxType = 0
End Select
AskToConvert = MsgBox(Msg, MsgBoxType, "Proper Case Function")
Else
AskToConvert = 0
End If
End Function
---------------------------------------
The customer may not always be right, but the customer is ALWAYS the customer.