Solved

Proper Case

Posted on 2014-02-01
8
362 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
U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

 
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 500 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

[Webinar] How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them. Thursday, July 13, 2017 10:00 A.M. PDT

Question has a verified solution.

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

AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

707 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