Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Correcting errors from 'Change Case' format 1

Status
Not open for further replies.

johnbarr44

Technical User
Feb 27, 2009
29
0
0
NZ
I'm using Excel 2003, and have a surname column where all entries have been entered in uppercase.
I wish to convert this format to 'Title Case', and have achieved it in most cases by copying to Word then using the 'Change Case' format function, then copying back into Excel.

However, it results in all the "Mc....." surnames now showing a lowercase third letter, and all the "Mac....." surnames now showing a lowercase fourth letter. Also, surnames beginning with "O'.........." now have a lowercase second letter, when the more desirable appearance is with an uppercase second letter.

e.g. I want
Mcdonald to be McDonald
Macdonald to be MacDonald
O'neill to be O'Neill

Is there any way to write a macro or formula to achieve this?
I have several workbooks and thousands of entries to work on.

TIA
John B
 
Hi there,

You could do this with a UDF...

Code:
Function ProperCase(vText As Variant) As String
    Dim sText As String
    sText = WorksheetFunction.Proper(CStr(Trim(vText)))
    If Len(sText) <= 2 Then GoTo ExitFunction
    If sText Like "Mc*" Then
        sText = "Mc" & UCase(Mid(sText, 3, 1)) & Right(sText, Len(sText) - 3)
    ElseIf sText Like "Mac*" Then
        sText = "Mac" & UCase(Mid(sText, 4, 1)) & Right(sText, Len(sText) - 4)
    ElseIf sText Like "O'*" Then
        sText = "O'" & UCase(Mid(sText, 3, 1)) & Right(sText, Len(sText) - 3)
    End If
ExitFunction:
    ProperCase = sText
End Function

You can use this logic in a sub routine if you'd like as well. You can also do it by a formulaic approach. If you'd like that, just specify and we can show you how to do it.

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP?
- Leonardo da Vinci
 
Hi Zack
Thanks for your reply.

Sorry but I've never used UDF before, and a search of the subject suggests it would take a while to learn (well, for me, anyway!).

Any chance of showing the equivalent code for a macro?

John B
 
I'm glad that code works for you, but do note that it makes certain assumptions that are not necessarily correct. Whether names with words like 'Van', 'Von', 'De', etc are 'correct' in lower case all depends on whose name it is, not what the word is. That said, such words are usually capitalised (check out a phone book) - which is the opposite of what the 'Proper_Case_Inner' macro does. That macro also aribtrarily converts all-cap words, like ABC to Abc and doesn't handle names like MacArthur. IMHO the code also capitalises some words that shouldn't be.

The following code is rather more sophisticated. It: capitalises the first word of every sentence; gives you the choice of whether all-cap words, like ABC, should be retained, allows you to decide which words should not the converted to proper case; and allows you to determine that words which are not ordinarily converted to proper case should be converted when they follow closing brackets and the like. You can also easily add/delete words to/from the general capitalisation-exlusions list:
Code:
Sub ConvertToProperCase()
Dim cell As Range
For Each cell In Selection
  cell.Value = ProperCase(cell.Value, bCaps:=True, bClos:=True, bExcl:=True)
Next
End Sub

Function ProperCase(StrTxt As Variant, Optional bCaps As Boolean, Optional bClos As Boolean, Optional bExcl As Boolean) As String
'Convert an input string to proper-case.
'Surnames like O', Mc & Mac and hyphenated names are converted to proper case also.
'If bCaps = True, then upper-case strings like ABC are preserved; otherwise they're converted.
'If bClos = False, words in the exclusion list after closing characters are retained as lower-case; otherwise they're converted.
'If bExcl = True, words in the exclusion list are retained as lower-case, unless after specified punctuation marks.
Dim i As Long, j As Long, k As Long, l As Long, bFnd As Boolean
Dim StrChr As String, StrExcl As String, StrMac As String, StrPunct As String, StrTmpA As String, StrTmpB As String
'General exclusion list.
StrExcl = "(a),a,am,an,and,are,as,at,(b),be,but,by,(c),can,cm,(d),did,do,does,(e),eg,en,eq,etc,(f),for," & _
          "(g),get,go,got,(h),has,have,he,her,him,how,(i),ie,if,in,into,is,it,its,(j),(k),(l),(m),me,mi," & _
          "mm,my,(n),na,nb,no,not,(o),of,off,ok,on,one,or,our,out,(p),(q),(r),re,(s),she,so,(t),the," & _
          "their,them,they,this,to,(u),(v),via,vs,(w),was,we,were,who,will,with,would,(x),(y),yd,you,your,(z)"
'Mac name lower-case list.
StrMac = "Macad,Macau,Macaq,Macaro,Macass,Macaw,Maccabee,Macedon,Macerate,Mach,Mack,Macle,Macrame,Macro,Macul,Macumb"
StrPunct = "!,;,:,.,?,/,(,{,[,<,“,"""
If bClos = True Then StrPunct = StrPunct & ",),},],>,”"
If bExcl = False Then
  StrExcl = ""
  StrPunct = ""
Else
  StrExcl = " " & Replace(Trim(StrExcl), ",", " , ") & " "
End If
If Len(Trim(StrTxt)) = 0 Then
  ProperCase = StrTxt
  Exit Function
End If
If bCaps = False Then StrTxt = LCase(StrTxt)
StrTxt = " " & StrTxt & " "
For i = 1 To UBound(Split(StrTxt, " ")) - 1
  StrTmpA = Split(StrTxt, " ")(i)
  'Check for a double-quote before the word
  If Left(StrTmpA, 1) Like "[""“”]" Then
    StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)
  Else
    StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)
  End If
  StrTmpB = " " & StrTmpB & " "
  StrTmpA = " " & StrTmpA & " "
  StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
Next
'Code for handling hyphenated words
For i = 1 To UBound(Split(StrTxt, "-"))
  StrTmpA = Split(StrTxt, "-")(i)
  StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)
  StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
Next
'Code for handling family names starting with O'
For i = 1 To UBound(Split(StrTxt, "'"))
  If InStr(Right(Split(StrTxt, "'")(i - 1), 2), " ") = 1 Or _
    Right(Split(StrTxt, "'")(i - 1), 2) = Right(Split(StrTxt, "'")(i - 1), 1) Then
    StrTmpA = Split(StrTxt, "'")(i)
    StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)
    StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
  End If
Next
'Code for handling family names starting with Mc
If Left(StrTxt, 2) = "Mc" Then
  Mid(StrTxt, 3, 1) = UCase(Mid(StrTxt, 3, 1))
End If
i = InStr(StrTxt, " Mc") + InStr(StrTxt, """Mc")
If i > 0 Then
  Mid(StrTxt, i + 3, 1) = UCase(Mid(StrTxt, i + 3, 1))
End If
'Code for handling family names starting with Mac
If InStr(1, StrTxt, "Mac", vbBinaryCompare) > 0 Then
  For i = 1 To UBound(Split(StrTxt, " "))
    StrTmpA = Split(StrTxt, " ")(i)
    If InStr(1, StrTmpA, "Mac", vbBinaryCompare) > 0 Then
      StrTmpA = Left(StrTmpA, Len(StrTmpA) - InStr(1, StrTmpA, "Mac", vbBinaryCompare) + 1)
      bFnd = False
      For j = 0 To UBound(Split(StrMac, ","))
        StrTmpB = Split(StrMac, ",")(j)
        If Left(StrTmpA, Len(StrTmpB)) = StrTmpB Then
          bFnd = True
          Exit For
        End If
      Next
      If bFnd = False Then
        If Len(Split(Trim(StrTmpA), " ")(0)) > 4 Then
          StrTmpB = StrTmpA
          Mid(StrTmpB, 4, 1) = UCase(Mid(StrTmpB, 4, 1))
          StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
        End If
      End If
    End If
  Next
End If
'Code to restore excluded words to lower case
If StrExcl <> "" Then
  For i = 0 To UBound(Split(StrExcl, ","))
    StrTmpA = Split(StrExcl, ",")(i)
    StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)
    If InStr(StrTxt, StrTmpB) > 0 Then
      StrTxt = Replace(StrTxt, StrTmpB, StrTmpA)
      'Make sure an excluded words following punctution marks are given proper case anyway
      For j = 0 To UBound(Split(StrPunct, ","))
        StrChr = Split(StrPunct, ",")(j)
        StrTxt = Replace(StrTxt, StrChr & StrTmpA, StrChr & StrTmpB)
      Next
    End If
  Next
End If
ProperCase = Trim(StrTxt)
End Function

Cheers
Paul Edstein
[MS MVP - Word]
 
Thanks for your reply, Paul, and for sharing your very sophisticated code.

Yes, I agree there are some drawbacks with the code I've used, but I modified it slightly e.g. to eliminate the 'Van', 'Von', 'De', options. As my Excel column contained only surnames it will suffice, but I can appreciate your solution would be wonderful for anyone handling large volumes of text.

Unfortunately, there will always be some exceptions to any rules that cannot be accounted for, no matter how elegant the code, e.g. Mackenzie and MacKenzie are both valid.

Cheers
John B

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top