How to capitilize automatically?

[charlesweaver33]

I have lots of cells designated for names that I'd like to make proper
case automatically as soon as you hit enter to move to the next cell,
whether it's entered as all lower case or upper case.

I've been reading around the web and mostly see suggestions for
temporary fixes. I'm trying to create a template which I'd like this
applied to every time I use it.

I just found out how cool excel is last week and now searching for
this answer I found out it gets even cooler with VBA stuff which I
know even less about than excel.

On this page I found a macro for proper case and a change event, which
if I understand correctly, utilizes the macro automatically?

http://www.mvps.org/dmcritchie/excel/proper.htm

The macro works fine but I'd like to get it to fix the name to proper
case as soon as you hit enter or tab.

So I installed the change event macro as the page said by clicking on
the sheet tab and pasting the code. I changed D and 4 to C and 3
because that's where my name column is (it's actually C and D merged
together. And I changed "personal.xls!Proper_Case" to where personal =
the file name of the worksheet I'm working on and saved it. I assume
that's what it's supposed to be, but we all know what happens when you
assume...

The macros are in all workbooks so I know it's there for my
worksheet. But this change event macro either 1. isn't working or 2.
I'm a moron and misunderstood the purpose of a change event macro or
3. I'm still a moron and understood the purpose of a change event
macro perfectly but just applied it wrongly.

The actual range I'd like this to apply to is C9 through C33 and C38
through C47. And remember that columns C and D are merged together if
that makes a difference.

Any help will be greatly appreciated.

Thanks,
Charles

 

[Guest]

Why don't you post the code you put in your workbook so we can vote on 1, 2
or 3.
<g>

 

[charlesweaver33]

Why don't you post the code you put in your workbook so we can vote on 1, 2
or 3.
<g>

This is what I applied to my worksheet:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Row = 1 Then Exit Sub 'don't override headings in row 1
If Target.Column <> 3 Then Exit Sub 'only allow changes to Col C
Application.EnableEvents = False
Application.Run "Install_Pay_Sheet.xls!Proper_Case", Target.Address
Application.EnableEvents = True
End Sub

And I have these macros installed, although the only one I'm really
interested in is proper case I figured it couldn't hurt to have more
just in case.

Option Explicit
'-- http://www.mvps.org/dmcritchie/excel/proper.htm
'-- http://www.mvps.org/dmcritchie/excel/code/proper.txt
Sub reset_things()
If Application.CommandBars(1).Enabled = False Then
Application.CommandBars(1).Enabled = True 'menu bar
MsgBox "Application.CommandBars(1).Enabled -- reset to True"
End If
If Application.CommandBars("Cell").Enabled = False Then
Application.CommandBars("Cell").Enabled = True 'rclick cell
MsgBox "Application.CommandBars(""cell"").Enabled -- reset to
True"
End If
If Application.CommandBars("PLY").Enabled = False Then
Application.CommandBars("PLY").Enabled = True 'rclick ws tab
MsgBox "Application.CommandBars(""PLY"").Enabled -- reset to
True"
End If
If Application.CommandBars("Toolbar List").Enabled <> True Then
Application.CommandBars("Toolbar List").Enabled = True
MsgBox "Application.CommandBars(""Toolbar List"").Enabled --
reset to True"
End If
If Application.EnableEvents <> True Then
Application.EnableEvents = True
MsgBox "Application.EnableEvents reset to True"
End If
If Application.ScreenUpdating <> True Then
Application.ScreenUpdating = True
MsgBox "Application.ScreenUpdating reset to True"
End If
If Application.Calculation <> xlCalculationAutomatic Then
' MsgBox "Application.Calcution not automatic was " &
application.caluwas reset to True"
Application.Calculation = xlCalculationAutomatic
End If
End Sub


Sub Proper_case()
'-- This macro is invoked by you -- i.e. from Macro Dialog (Alt
+F8)
Proper_Case_Inner 'The macro you invoke from a menu is
Proper_Case
End Sub
Sub Proper_Case_Inner(Optional mySelection As String)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
Dim rng As Range
On Error Resume Next 'In case no cells in selection
If mySelection = "" Then Set rng = Selection _
Else Set rng = Range(mySelection)
For Each cell In Intersect(rng, _
rng.SpecialCells(xlConstants, xlTextValues))
cell.Formula = StrConv(cell.Formula, vbProperCase)
'--- this is where you would code generalized changes for
lastname
'--- applied to names beginning in position 1 of cell
If Left(cell.Value, 2) = "Mc" Then cell.Value = _
"Mc" & UCase(Mid(cell.Value, 3, 1)) & Mid(cell.Value, 4,
99)
If Left(cell.Value, 3) = "Mac" _
And Left(cell.Value, 4) <> "Mack" Then cell.Value = _
"Mac" & UCase(Mid(cell.Value, 4, 1)) & Mid(cell.Value, 5,
99)
'-- do not change Mack Mackey Mackney or any Mack...
If Left(cell.Value, 2) = "O'" Then cell.Value = _
"O'" & UCase(Mid(cell.Value, 3, 1)) & Mid(cell.Value, 4,
99)
If Left(cell.Value, 8) = "Van Den " Then cell.Value = _
"van den " & Mid(cell.Value, 9, 99)
If Left(cell.Value, 8) = "Van Der " Then cell.Value = _
"van der " & Mid(cell.Value, 9, 99)
'-- single parts after those with two part prefixes
If Left(cell.Value, 3) = "Vd " Then cell.Value = _
"vd " & Mid(cell.Value, 4, 99)
If Left(cell.Value, 4) = "V/D " Then cell.Value = _
"v/d " & Mid(cell.Value, 5, 99)
If Left(cell.Value, 4) = "V.D " Then cell.Value = _
"v.d " & Mid(cell.Value, 5, 99)
If Left(cell.Value, 3) = "De " Then cell.Value = _
"de " & Mid(cell.Value, 4, 99)
If Left(cell.Value, 4) = "Van " Then cell.Value = _
"van " & Mid(cell.Value, 5, 99)
If Left(cell.Value, 4) = "Von " Then cell.Value = _
"von " & Mid(cell.Value, 5, 99)
Next
'-- some specific text changes to lowercase, not in first
position
rng.Replace what:=" a ", replacement:=" a ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" and ", replacement:=" and ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" at ", replacement:=" at ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" for ", replacement:=" for ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" from ", replacement:=" from ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" in ", replacement:=" in ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" of ", replacement:=" of ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" on ", replacement:=" on ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
rng.Replace what:=" the ", replacement:=" the ", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
'--- This is where you would code specific name changes
'--- regardless of position of character string in the cell
rng.Replace what:="mcritchie", replacement:="McRitchie", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
CapWords (mySelection) 'activate if you want to run macro
End Sub
Sub CapWords(Optional mySelection As String)
'Expect all substitutions here would be to capitals
'not necessarily limited to words
Dim savCalc As Long, savScrnUD As Boolean
savCalc = Application.Calculation
savScrnUD = Application.ScreenUpdating
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Dim rng As Range
On Error GoTo done 'In case no cells in selection
If mySelection = "" Then Set rng = Selection _
Else: Set rng = Range(mySelection)
rng.Replace what:="IBM", replacement:="IBM", _
lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False
done:
Application.Calculation = savCalc
Application.ScreenUpdating = savScrnUD
End Sub
Sub MakeProper_Quick_test()
Range("A1").Formula = "=""asdf ""&ADDRESS(ROW(),COLUMN(),4)&""
qwer"""
Dim i As Long
i = InputBox("type 1 to convert all to values", "values", 1)
If i = 1 Then
Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
End If
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:H1"),
Type:=xlFillDefault
Range("A1:H1").Select
Selection.AutoFill Destination:=Range("A1:H29"),
Type:=xlFillDefault
Range("A1:H29").Select
Range("B5:F17,H6:H12,D2125,G20:G26,B23:B27").Select
Range("B23").Activate
Application.Run "MakeProper_Quick"
End Sub

Sub MakeProper_Quick()
'Dave Peterson, 2003-03-21, misc, no loop required...
'-- doesn't work with application.upper and application.lower
Application.ScreenUpdating = False
Dim myRng As Range
Dim myArea As Range
On Error Resume Next
Set myRng = Intersect(Selection, ActiveSheet.UsedRange)
If myRng Is Nothing Then
MsgBox "Nothing in intersect range"
Else
For Each myArea In myRng.Areas
myArea.Formula = Application.Proper(myArea.Formula)
Next myArea
End If
Application.ScreenUpdating = True
End Sub

Sub Lower_Case()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'in XL97
Dim cell As Range
On Error Resume Next 'In case no cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Formula = LCase(cell.Formula)
Next
Application.Calculation = xlCalculationAutomatic 'in XL97
Application.ScreenUpdating = True
End Sub
Sub Upper_Case()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
On Error Resume Next 'In case no cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
cell.Formula = UCase(cell.Formula)
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub Upper_Case_ALL()
'David McRitchie, programming, 2003-03-07
Dim rng1 As Range, rng2 As Range, bigrange As Range
Dim cell As Range
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 = UCase(cell.Formula)
Next cell
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Sub Formulas_to_Values()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
On Error Resume Next 'In case no cells in selection
For Each cell In Selection.SpecialCells(xlFormulas)
cell.Value = cell.Value
If Trim(cell.Value) = "" Then cell.Formula = ""
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub ClearNumberConstants()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
On Error Resume Next 'In case no such cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlNumbers))
cell.Formula = ""
Next cell
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub FindFirstChar() '--Optional firstChar As String)
Dim cell As Range
'-- dim firstChar As String
If firstChar = "" Then _
firstChar = UCase(InputBox("Supply prefix character(s) " _
& "to find first occurence", "Find First Char(s)", "W"))
If firstChar = "" Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'in XL97
On Error Resume Next 'In case no cells in selection
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
If Left(UCase(cell), Len(firstChar)) = firstChar Then
cell.Activate
GoTo leavemacro
End If
Next cell
leavemacro:
Application.Calculation = xlCalculationAutomatic 'in XL97
Application.ScreenUpdating = True
End Sub

 

[Guest]

This will get you started:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("C:C"), Target) > "" Then
Range("C3").Value = StrConv(Range("C3").Value, 3)
End If
End Sub

I did not see the specific macro that you referenced in your WS change code,
but if you substitute it on the command line of the if statement above and
you still don't get the results you want, then it will be that macro that is
the problem. The one above will execute, as is, and will change whatever is
in Range("C3") of that worksheet to ProperCase.

 

[Guest]

P.S. It will only execute if the Target is in column C.

 

[charlesweaver33]

This will get you started:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("C:C"), Target) > "" Then
Range("C3").Value = StrConv(Range("C3").Value, 3)
End If
End Sub

I did not see the specific macro that you referenced in your WS change code,
but if you substitute it on the command line of the if statement above and
you still don't get the results you want, then it will be that macro that is
the problem. The one above will execute, as is, and will change whatever is
in Range("C3") of that worksheet to ProperCase.

I'm sorry I'm still new so I'm not sure what you mean by "WS" change
code and I have absolutely no idea what the command line is on the if
statement. I did come close to what I'm trying to achieve though. On
another site I found a code for proper for a macro and it also has a
change code for Upper to which it says all you have to do is change it
to proper if that's what you want like it previously described. The
trouble is I can't get it to work. It looks like it's looking for
something different than just entering "vbProperCase".

This is my macro and my only macro now:

Sub Proper_Case()
Dim Rng As Range
For Each Rng In Selection.Cells
If Rng.HasFormula = False Then
Rng.Value = StrConv(Rng.Value, vbProperCase)
End If
Next Rng
End Sub

This is my change code and it is entered on sheet 1:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
End Sub

This works beautifully to change it to upper case but I can't figure
out how to do proper case instead. I've tried changing UCase to
vbproper case, proper, propercase, none worked. I also tried replacing
the whole line with rng.value line from the macro. Obviously I'm not
doing something right, I just don't know what.

Ideas?

Charles

 

[NickHK]

VBA does not have a ProperCase function as such. Therefore you need to use
StrConv function that you were given.
I would use vbProperCase in place of the magic number 3 for clarity, but
either is valid.

Target(1).Value = UCase(Target(1).Value)

Target(1).Value = StrConv(Target(1).Value, vbProperCase)

NickHK

 

[Susan]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change

If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = UCase(Target(1).Value)

to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)


does that work?

susan

 

[charlesweaver33]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change


to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)

does that work?

susan

Hi Susan,

Unfortunately no, it doesn't. I've tried that, vbProperCase, Proper,
PCase and all to no avail. I don't know what it's looking for but one
thing I have noticed that's different simply for changing case,
wherever I look on the web people's code has simple UCase and LCase
lines, but for proper case everyone seems to recommend "StrConv". I
don't know if that has anything to do with anything but something sure
ain't working right to get these cells to change to proper case.

 

[charlesweaver33]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change


to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)

does that work?

susan

Hi Susan,

Unfortunately no, it doesn't. I've tried that, vbProperCase, Proper,
PCase and all to no avail. I don't know what it's looking for but one
thing I have noticed that's different simply for changing case,
wherever I look on the web people's code has simple UCase and LCase
lines, but for proper case everyone seems to recommend "StrConv". I
don't know if that has anything to do with anything but something sure
ain't working right to get these cells to change to proper case.

 

[charlesweaver33]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change


to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)

does that work?

susan

Susan, unfortunately no it doesn't work. I've tried using
vbProperCase, ProperCase, PCase, and Proper and all to no avail. I
think this change event doesn't like me. It only wants to work for
Upper Case.

Any ideas?

 

[charlesweaver33]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change


to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)

does that work?

susan

Susan, unfortunately no it doesn't work. I've tried using
vbProperCase, ProperCase, PCase, and Proper and all to no avail. I
think this change event doesn't like me. It only wants to work for
Upper Case.

Any ideas?

 

[charlesweaver33]

just as a quickie test this worked for me..........
====================
Sub change_case()

Dim ws As Worksheet
Dim c As Range
Dim s As String

Set ws = ActiveSheet
Set c = ws.Range("e5")
s = "mary smith"

c = s
c.Value = StrConv(c.Value, vbProperCase)

End Sub
================
result was "Mary Smith".

(WS is short for worksheet, so JLGWhiz was talking about your
worksheet_change event. the command line is the line that calls
another macro.)

what happens when you change


to
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
Target(1).Value = ProperCase(Target(1).Value)

does that work?

susan

Okay, I'm gonna try this for the third time. Dang thing keeps losing
my post.

I've tried doing that as well as using Proper, vbProperCase, PCase and
none worked. At least I don't think so. I may have been doing it wrong
somehow. After I tried using those and they didn't work I would change
it back to UCase which worked before, but when I change it back, it
wouldn't.

Charles

 

[NickHK]

You cannot be using the code originally posted by JLGWhiz. Read the help on
strConv also to see that values of Proper, PCase, etc are not valid.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Not Application.Intersect(Target, Range("C9:C47")) Is Nothing Then
' Target(1).Value = UCase(Target(1).Value)
Target(1).Value = StrConv(Target(1).Value, vbProperCase)
End If
Application.EnableEvents = True

End Sub

NickHK