Enhanced Proper Case

  • Thread starter Thread starter plantechbl
  • Start date Start date
P

plantechbl

Enhanced Proper Case
I am looking for a macro to enhance the "Proper" case function or
code.
What I would like to do is take a cell entry and change it to proper
case but leave certain words lower case, for example:
The quick brown fox and the hare
Changed to:
The Quick Brown Fox and the Hare
I would like to have a list of words (" and ", " the ", " of ", etc.
<the spaces assist in only changing the words within the string>) in a
sheet that I can add to to create my word exclusions, much the same
way that the networkdays function uses a list for holidays. I can
crudely accomplish this by using "Proper" then "Replace" but it would
seem that a more streamlined approach could be developed.
Thanks in advance,
Bill
 
Try this David McRitchie

As written will proper "The" only if it is first word of string.

Sub Exception_Click()
'David McRitchie, programming, 2003-03-07
Dim rng1 As Range, rng2 As Range, bigrange As Range
Dim Cell As Range
Dim sStr As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Set rng1 = Intersect(Selection, _
Selection.SpecialCells(xlCellTypeConstants))
Set rng2 = Intersect(Selection, _
Selection.SpecialCells(xlCellTypeFormulas))
On Error GoTo 0
If rng1 Is Nothing Then
Set bigrange = rng2
ElseIf rng2 Is Nothing Then
Set bigrange = rng1
Else
Set bigrange = Union(rng1, rng2)
End If
If bigrange Is Nothing Then
MsgBox "All cells in range are EMPTY"
GoTo done
End If
For Each Cell In bigrange
Cell.Formula = Application.Proper(cell.Formula)
sStr = Application.WorksheetFunction.Proper(Cell.Formula)
sStr = Application.Substitute(sStr, " Of ", " of ")
sStr = Application.Substitute(sStr, " Is ", " is ")
sStr = Application.Substitute(sStr, " And ", " and ")
sStr = Application.Substitute(sStr, " A ", " a ")
sStr = Application.Substitute(sStr, " The ", " the ")
sStr = Application.Substitute(sStr, " An ", " an ")
sStr = Application.Substitute(sStr, "Th ", "th ")
sStr = Application.Substitute(sStr, "Nd ", "nd ")
sStr = Application.Substitute(sStr, "Rd ", "rd ")
Cell.Formula = sStr
Next Cell
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP
 
Outstanding!! This will save a lot of time standardizing some very
large excel database entries.
Thank you very much.
Another thought...Can this be turned into a UDF and used like the
other excel functions for text case?
 
Change to a UDF?

Not by this scribe<g>


Gord

Outstanding!! This will save a lot of time standardizing some very
large excel database entries.
Thank you very much.
Another thought...Can this be turned into a UDF and used like the
other excel functions for text case?
Click to expand...
 
It looks like most of David McRitchie's code goes away:

Option Explicit
Function myProper(myCell As Range) As String
Dim sStr As String

Set myCell = myCell.Cells(1)

sStr = Application.WorksheetFunction.Proper(myCell.Value)
sStr = Application.Substitute(sStr, " Of ", " of ")
sStr = Application.Substitute(sStr, " Is ", " is ")
sStr = Application.Substitute(sStr, " And ", " and ")
sStr = Application.Substitute(sStr, " A ", " a ")
sStr = Application.Substitute(sStr, " The ", " the ")
sStr = Application.Substitute(sStr, " An ", " an ")
sStr = Application.Substitute(sStr, "Th ", "th ")
sStr = Application.Substitute(sStr, "Nd ", "nd ")
sStr = Application.Substitute(sStr, "Rd ", "rd ")

myProper = sStr

End Function
 
Thanks for helping out Dave.

I sure didn't know where to start with my limited VBA skills.


Gord
 
Thanks very much to both of you! The function works great as it allows
the user to see the before and after of the cell entry. I can then
copy/paste special/values over the original entry to complete the
task. I have added some additional keywords and abbreviations that I
am finding in cleaning up my database project.

Option Explicit
Function myProper(myCell As Range) As String
Dim sStr As String


Set myCell = myCell.Cells(1)


sStr = Application.WorksheetFunction.Proper(myCell.Value)
sStr = Application.Substitute(sStr, " Of ", " of ")
sStr = Application.Substitute(sStr, " Is ", " is ")
sStr = Application.Substitute(sStr, " And ", " and ")
sStr = Application.Substitute(sStr, " A ", " a ")
sStr = Application.Substitute(sStr, " The ", " the ")
sStr = Application.Substitute(sStr, " An ", " an ")
sStr = Application.Substitute(sStr, "Th ", "th ")
sStr = Application.Substitute(sStr, "Nd ", "nd ")
sStr = Application.Substitute(sStr, "Rd ", "rd ")
sStr = Application.Substitute(sStr, " Or ", " or ")
sStr = Application.Substitute(sStr, " To ", " to ")
'Roman Numerals
sStr = Application.Substitute(sStr, " Ii ", " II ")
sStr = Application.Substitute(sStr, " Ii ", " II ")
sStr = Application.Substitute(sStr, " Iii ", " III ")
'Independent School District
sStr = Application.Substitute(sStr, " Isd ", " ISD ")
'High School
sStr = Application.Substitute(sStr, " Hs ", " HS ")
'Compass Directions
sStr = Application.Substitute(sStr, " Ne ", " NE ")
sStr = Application.Substitute(sStr, " Nw ", " NW ")
sStr = Application.Substitute(sStr, " Sw ", " SW ")
sStr = Application.Substitute(sStr, " Se ", " SE ")


myProper = sStr


End Function
 
Back
Top