Solved

Proper Case

Posted on 2014-02-01
8
344 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
  • 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
 
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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 
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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

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

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

895 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now