Link to home
Start Free TrialLog in
Avatar of Lawrence Salvucci
Lawrence SalvucciFlag for United States of America

asked on

Proper Case

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

Avatar of Joe Howard
Joe Howard
Flag of United States of America image
"ABC Inc". will return "Abc Inc.".

How can the function know which first words you want all capitalized?
Avatar of Joe Howard
Joe Howard
Flag of United States of America image
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

Avatar of Lawrence Salvucci
Lawrence Salvucci
Flag of United States of America image

ASKER

I just tested your revised code and entered "ABC" and it converted it to this: Abcabcabcabc
Avatar of Joe Howard
Joe Howard
Flag of United States of America image
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

Avatar of Lawrence Salvucci
Lawrence Salvucci
Flag of United States of America image

ASKER

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"
ASKER CERTIFIED SOLUTION
Avatar of Joe Howard
Joe Howard
Flag of United States of America image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Lawrence Salvucci
Lawrence Salvucci
Flag of United States of America image

ASKER

Thank you very much for your help!
Avatar of Joe Howard
Joe Howard
Flag of United States of America image
You're welcome.