Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 377
  • Last Modified:

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

0
Lawrence Salvucci
Asked:
Lawrence Salvucci
  • 5
  • 3
1 Solution
 
MacroShadowCommented:
"ABC Inc". will return "Abc Inc.".

How can the function know which first words you want all capitalized?
0
 
MacroShadowCommented:
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
 
Lawrence SalvucciInformation Technology ManagerAuthor Commented:
I just tested your revised code and entered "ABC" and it converted it to this: Abcabcabcabc
0
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

 
MacroShadowCommented:
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
 
Lawrence SalvucciInformation Technology ManagerAuthor Commented:
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
 
MacroShadowCommented:
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
 
Lawrence SalvucciInformation Technology ManagerAuthor Commented:
Thank you very much for your help!
0
 
MacroShadowCommented:
You're welcome.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now