Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Proper Case

Posted on 2014-02-01
8
Medium Priority
?
370 Views
Last Modified: 2014-02-03
I'm using the following code for Proper Case for my company names in my DB but there are a few instances that this isn't picking up when I type in a new company name that is all caps. For example if I enter just "ABC" it changes it to "Abc". If I enter in "ABC Inc." it capitalizes "ABC" correctly. And when I enter a 4 or 5 letter company name that should all be caps it changes everything to lower case except for the first letter. How can I modify this code to work properly?

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 automatically capitalize all 2 or 3 character words, then call in this manner:
'   ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will automatically capitalize if all
' of the characters in the string are the same, regardles of the value of this parameter (AAA Insurance Company)
 
'If any improvements/clean up/errors found in this code, please
'email David McAfee at davidmcafee@gmail.com
Dim intCounter As Integer
Dim OneChar As String
Dim StartingNumber As Integer
StartingNumber = 1

If Nz(strText, "") <> "" Then 'If value is not blank, then continue below
    '******************** Start - Check for 3 character words at the start of string
        If Right(Left(strText, 4), 1) = " " Or Right(Left(strText, 4), 1) = "," Or Right(Left(strText, 4), 1) = "/" Then
        If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText, 1) = Mid$(strText, 3, 1)) Or blPrompt = True Then
            'Capitalize the 3 char's as in "AAA" or "EEE Movers"
            strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText, 4, 255))
            StartingNumber = 4
        Else
            'Only capitalize the first of the 3 char's
            'This part can be removed if you do not want the 1st letter capitalized
            strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
            StartingNumber = 2
        End If '******************** End - 3 letter check at beginning of string
  
    ElseIf Right(Left(strText, 3), 1) = " " Or Right(Left(strText, 3), 1) = "," Or 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 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
            'This part can be removed if you do not want the 1st letter capitalized
            strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
            StartingNumber = 2
        End If '***************** End 2 character word Check
  Else
    'The first word is not 2 or 3 char in length, so 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, 2) = "Mc") Then 'Check if Prev Char is an M
                If ((intCounter - 2) < 1) Then 'Check to see if the M was the first character
                    strText = "Mc" & 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  or maria de jesus
                    strText = Left$(strText, intCounter) & "de " & Mid$(strText, intCounter + 4, 255)
                    intCounter = intCounter + 2
               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
            'Method for adding new case is fairly simple, such in the example above: "de "
            'If Mid$(strText, intCounter + 1, Len("YourExclusionHere")) = "YourExclusionHere" Then
            '   strText = Left$(strText, intCounter) & "YourExclusionHere" & Mid$(strText, intCounter + (LEN("YourExclusionHere")+1), 255)
            'End If
            '*********************** Check for 3 character word *******************
            If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText) - intCounter = 3) Then
                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 Then
                    'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                    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
                    'This part can be removed if you do not want the 1st letter capitalized
                    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) = " " Or (Len(strText) - intCounter = 2) Then
                If (Mid(strText, intCounter + 1, 1) = Mid(strText, intCounter + 2, 1)) Or blPrompt = True Then
                      'Capitalize the 2 char's
                      'This part can be omitted if you do not want to automatically capitalize a 2 character word made up of two identical letters
                      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

Open in new window

0
Comment
Question by:Lawrence Salvucci
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39827102
"ABC Inc". will return "Abc Inc.".

How can the function know which first words you want all capitalized?
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39827112
This does what you want if you know you want the first word all capitalized. I added an optional parameter, set it to true if you want the first word all capitalized.
Function fProperCase(strText As String, Optional blFirstAllCaps As Boolean = False) As String
'Call this function in this manner:
'   ProperCase("yourTexthere")
' If you would like to automatically capitalize all 2 or 3 character words, then call in this manner:
'   ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will automatically capitalize if all
' of the characters in the string are the same, regardles of the value of this parameter (AAA Insurance Company)

'If any improvements/clean up/errors found in this code, please
'email David McAfee at davidmcafee@gmail.com
    Dim intCounter As Integer
    Dim OneChar As String
    Dim StartingNumber As Integer
    StartingNumber = 1

    If Nz(strText, "") <> "" Then    'If value is not blank, then continue below
        If blFirstAllCaps Then
            strText = UCase(Mid(strText, 1, Len(strText) - InStr(strText, " "))) & LCase$(Mid$(strText, InStr(strText, " ") + 1, 255))
            StartingNumber = InStr(strText, " ") + 1
            '            GoTo Nextm
        End If

        '******************** Start - Check for 3 character words at the start of string
        If Right(Left(strText, 4), 1) = " " Or Right(Left(strText, 4), 1) = "," Or Right(Left(strText, 4), 1) = "/" Then
            If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText, 1) = Mid$(strText, 3, 1)) Then
                'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText, 4, 255))
                StartingNumber = 4
            Else
                If Not blFirstAllCaps Then
                    'Only capitalize the first of the 3 char's
                    'This part can be removed if you do not want the 1st letter capitalized
                    strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                    StartingNumber = 2
                End If
            End If    '******************** End - 3 letter check at beginning of string

        ElseIf Right(Left(strText, 3), 1) = " " Or Right(Left(strText, 3), 1) = "," Or 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) Then
                'Capitalize the 2 char's
                strText = UCase(Left$(strText, 2)) & LCase$(Mid$(strText, 3, 255))
                StartingNumber = 3
            Else
                If Not blFirstAllCaps Then
                    'Only capitalize the first of the 2 char's
                    'This part can be removed if you do not want the 1st letter capitalized
                    strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                    StartingNumber = 2
                End If
            End If    '***************** End 2 character word Check
        Else
            'The first word is not 2 or 3 char in length, so 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, 2) = "Mc") Then    'Check if Prev Char is an M
                        If ((intCounter - 2) < 1) Then    'Check to see if the M was the first character
                            strText = "Mc" & 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  or maria de jesus
                            strText = Left$(strText, intCounter) & "de " & Mid$(strText, intCounter + 4, 255)
                            intCounter = intCounter + 2
                        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
                    'Method for adding new case is fairly simple, such in the example above: "de "
                    'If Mid$(strText, intCounter + 1, Len("YourExclusionHere")) = "YourExclusionHere" Then
                    '   strText = Left$(strText, intCounter) & "YourExclusionHere" & Mid$(strText, intCounter + (LEN("YourExclusionHere")+1), 255)
                    'End If
                    '*********************** Check for 3 character word *******************
                    If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText) - intCounter = 3) Then
                        If (Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 2, 1) And _
                            Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 3, 1)) Then
                            'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                            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
                            'This part can be removed if you do not want the 1st letter capitalized
                            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) = " " Or (Len(strText) - intCounter = 2) Then
                        If (Mid(strText, intCounter + 1, 1) = Mid(strText, intCounter + 2, 1)) Then
                            'Capitalize the 2 char's
                            'This part can be omitted if you do not want to automatically capitalize a 2 character word made up of two identical letters
                            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

Open in new window

0
 
LVL 1

Author Comment

by:Lawrence Salvucci
ID: 39827129
I just tested your revised code and entered "ABC" and it converted it to this: Abcabcabcabc
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Expert Comment

by:MacroShadow
ID: 39827317
Function fProperCase(Optional strText As String, Optional blFirstAllCaps As Boolean = False) As String
'Call this function in this manner:
'   ProperCase("yourTexthere")
' If you would like to automatically capitalize all 2 or 3 character words, then call in this manner:
'   ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will automatically capitalize if all
' of the characters in the string are the same, regardles of the value of this parameter (AAA Insurance Company)

'If any improvements/clean up/errors found in this code, please
'email David McAfee at davidmcafee@gmail.com
    Dim intCounter As Integer
    Dim OneChar As String
    Dim StartingNumber As Integer
    StartingNumber = 1

    If Nz(strText, "") <> "" Then    'If value is not blank, then continue below
        '******************** Start - Check for 3 character words at the start of string
        If Right(Left(strText, 4), 1) = " " Or Right(Left(strText, 4), 1) = "," Or Right(Left(strText, 4), 1) = "/" Then
            If (Left(strText, 1) = Mid$(strText, 2, 1) And Left(strText, 1) = Mid$(strText, 3, 1)) Then
                'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                strText = UCase(Left$(strText, 3)) & LCase$(Mid$(strText, 4, 255))
                StartingNumber = 4
            Else
                'Only capitalize the first of the 3 char's
                'This part can be removed if you do not want the 1st letter capitalized
                strText = UCase$(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                StartingNumber = 2
            End If    '******************** End - 3 letter check at beginning of string

        ElseIf Right(Left(strText, 3), 1) = " " Or Right(Left(strText, 3), 1) = "," Or 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) 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
                'This part can be removed if you do not want the 1st letter capitalized
                strText = UCase(Left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                StartingNumber = 2
            End If    '***************** End 2 character word Check
        Else
            'The first word is not 2 or 3 char in length, so 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, 2) = "Mc") Then    'Check if Prev Char is an M
                        If ((intCounter - 2) < 1) Then    'Check to see if the M was the first character
                            strText = "Mc" & 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  or maria de jesus
                            strText = Left$(strText, intCounter) & "de " & Mid$(strText, intCounter + 4, 255)
                            intCounter = intCounter + 2
                        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
                    'Method for adding new case is fairly simple, such in the example above: "de "
                    'If Mid$(strText, intCounter + 1, Len("YourExclusionHere")) = "YourExclusionHere" Then
                    '   strText = Left$(strText, intCounter) & "YourExclusionHere" & Mid$(strText, intCounter + (LEN("YourExclusionHere")+1), 255)
                    'End If
                    '*********************** Check for 3 character word *******************
                    If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText) - intCounter = 3) Then
                        If (Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 2, 1) And _
                            Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 3, 1)) Then
                            'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                            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
                            'This part can be removed if you do not want the 1st letter capitalized
                            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) = " " Or (Len(strText) - intCounter = 2) Then
                        If (Mid(strText, intCounter + 1, 1) = Mid(strText, intCounter + 2, 1)) Then
                            'Capitalize the 2 char's
                            'This part can be omitted if you do not want to automatically capitalize a 2 character word made up of two identical letters
                            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

    If blFirstAllCaps Then
        strText = UCase(Left(strText, Len(strText) - InStr(StrReverse(strText), " "))) & IIf(InStr(strText, " ") > 1, Right(strText, Len(strText) - InStr(strText, " ") + 1), "")
        intCounter = InStr(strText, " ") + 1
    End If

    'All done, return current contents of strText variable.
    fProperCase = strText

End Function

Open in new window

0
 
LVL 1

Author Comment

by:Lawrence Salvucci
ID: 39828561
Ok that seemed to work when I tested it using "ABC" as the company name. But then when I tried to enter this as a customer "Aberdeen Business Solutions" I got this: "ABERDEEN BUSINESS BUSINESS Business Business Solutions"
0
 
LVL 27

Accepted Solution

by:
MacroShadow earned 2000 total points
ID: 39828799
Sorry, this works for me:
Function fProperCase(Optional strText As String, Optional blFirstAllCaps As Boolean = False) As String
'Call this function in this manner:
'   ProperCase("yourTexthere")
' If you would like to automatically capitalize all 2 or 3 character words, then call in this manner:
'   ProperCase(yourTexthere,1)
' Please note any two or three character words in the string will automatically capitalize if all
' of the characters in the string are the same, regardles of the value of this parameter (AAA Insurance Company)

'If any improvements/clean up/errors found in this code, please
'email David McAfee at davidmcafee@gmail.com
    Dim intCounter As Integer
    Dim OneChar As String
    Dim StartingNumber As Integer
    StartingNumber = 1

    If Nz(strText, "") <> "" Then    'If value is not blank, then continue below
        '******************** Start - Check for 3 character words at the start of string
        If Right(left(strText, 4), 1) = " " Or Right(left(strText, 4), 1) = "," Or Right(left(strText, 4), 1) = "/" Then
            If (left(strText, 1) = Mid$(strText, 2, 1) And left(strText, 1) = Mid$(strText, 3, 1)) Then
                'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                strText = UCase(left$(strText, 3)) & LCase$(Mid$(strText, 4, 255))
                StartingNumber = 4
            Else
                'Only capitalize the first of the 3 char's
                'This part can be removed if you do not want the 1st letter capitalized
                strText = UCase$(left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                StartingNumber = 2
            End If    '******************** End - 3 letter check at beginning of string

        ElseIf Right(left(strText, 3), 1) = " " Or Right(left(strText, 3), 1) = "," Or 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) 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
                'This part can be removed if you do not want the 1st letter capitalized
                strText = UCase(left$(strText, 1)) & LCase$(Mid$(strText, 2, 255))
                StartingNumber = 2
            End If    '***************** End 2 character word Check
        Else
            'The first word is not 2 or 3 char in length, so 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, 2) = "Mc") Then    'Check if Prev Char is an M
                        If ((intCounter - 2) < 1) Then    'Check to see if the M was the first character
                            strText = "Mc" & 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  or maria de jesus
                            strText = left$(strText, intCounter) & "de " & Mid$(strText, intCounter + 4, 255)
                            intCounter = intCounter + 2
                        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
                    'Method for adding new case is fairly simple, such in the example above: "de "
                    'If Mid$(strText, intCounter + 1, Len("YourExclusionHere")) = "YourExclusionHere" Then
                    '   strText = Left$(strText, intCounter) & "YourExclusionHere" & Mid$(strText, intCounter + (LEN("YourExclusionHere")+1), 255)
                    'End If
                    '*********************** Check for 3 character word *******************
                    If Mid$(strText, intCounter + 4, 1) = " " Or (Len(strText) - intCounter = 3) Then
                        If (Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 2, 1) And _
                            Mid$(strText, intCounter + 1, 1) = Mid$(strText, intCounter + 3, 1)) Then
                            'Capitalize the 3 char's as in "AAA" or "EEE Movers"
                            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
                            'This part can be removed if you do not want the 1st letter capitalized
                            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) = " " Or (Len(strText) - intCounter = 2) Then
                        If (Mid(strText, intCounter + 1, 1) = Mid(strText, intCounter + 2, 1)) Then
                            'Capitalize the 2 char's
                            'This part can be omitted if you do not want to automatically capitalize a 2 character word made up of two identical letters
                            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

    If blFirstAllCaps Then
        strText = UCase(FirstWord(strText)) & IIf(InStr(strText, " ") > 1, Right(strText, Len(strText) - InStr(strText, " ") + 1), "")
        intCounter = InStr(strText, " ") + 1
    End If

    'All done, return current contents of strText variable.
    fProperCase = strText

End Function

Public Function FirstWord(strInput As String)
    Dim arr() As String
    arr = Split(strInput, " ")

    FirstWord = arr(0)
End Function

Open in new window

0
 
LVL 1

Author Closing Comment

by:Lawrence Salvucci
ID: 39829119
Thank you very much for your help!
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39829142
You're welcome.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you need a simple but flexible process for maintaining an audit trail of who created, edited, or deleted data from a table, or multiple tables, and you can do all of your work from within a form, this simple Audit Log will work for you.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

609 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question