Enhanced Proper Case

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

plantechbl@embarqmail.com - 11 Dec 2007 19:48 GMT

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

Reply to this Message

Gord Dibben - 11 Dec 2007 21:19 GMT

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

>Enhanced Proper Case
>I am looking for a macro to enhance the "Proper" case function or
[quoted text clipped - 12 lines]
>Thanks in advance,
>Bill

Reply to this Message

plantechbl@embarqmail.com - 11 Dec 2007 21:59 GMT

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?

> Try this David McRitchie
>
[quoted text clipped - 63 lines]
>
> - Show quoted text -

Reply to this Message

Gord Dibben - 11 Dec 2007 23:43 GMT

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.
[quoted text clipped - 69 lines]
>>
>> - Show quoted text -

Reply to this Message

Dave Peterson - 11 Dec 2007 23:58 GMT

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

> Outstanding!! This will save a lot of time standardizing some very
> large excel database entries.
[quoted text clipped - 69 lines]
> >
> > - Show quoted text -

Signature

Dave Peterson

Reply to this Message

Gord Dibben - 12 Dec 2007 00:23 GMT

Thanks for helping out Dave.

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

Gord

>It looks like most of David McRitchie's code goes away:
>
[quoted text clipped - 92 lines]
>> >
>> > - Show quoted text -

Reply to this Message

Dave Peterson - 12 Dec 2007 01:26 GMT

You're welcome, Gord.

> Thanks for helping out Dave.
>
[quoted text clipped - 98 lines]
> >> >
> >> > - Show quoted text -

Signature

Dave Peterson

Reply to this Message

plantechbl@embarqmail.com - 12 Dec 2007 15:38 GMT

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

> You're welcome, Gord.
>
[quoted text clipped - 108 lines]
>
> - Show quoted text -

Reply to this Message