Cap everyword in each cell of a column - macro issue

[skyport]

Need help with this:

I want to cap the first letter of every word within a cell, NOT just the first word.

=proper(A) doesn't work for me because if a word has an 's at the end such as Physician's, it will also cap that s so it ends up as Physician'S.

The following program works great for me with one problem. It caps each word correctly but I have to hit escape to get it to stop working and go on to other functions otherwise cannot stop it from continuing on after it does the job.

Can someone help me find the brakes to make it stop spinning?

Sub ToProperA()
Dim a As Range
For Each a In Selection
a.Value = StrConv(a.Value, vbProperCase)
Next a
End Sub

 

[skyport]

Thanks again for sticking with me on this. see the example results below when I ran the program. It eliminated the problem with the 'S however, note that it won't cap any word following the one that contains the apostrophe.

BEFORE

[TABLE="width: 281"]
<colgroup><col></colgroup><tbody>[TR]
[TD]test report[/TD]
[/TR]
[TR]
[TD]big ol fat report[/TD]
[/TR]
[TR]
[TD]physician's report and request[/TD]
[/TR]
[TR]
[TD]bill's old report

AFTER

[TABLE="width: 281"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Test Report[/TD]
[/TR]
[TR]
[TD]Big Ol Fat Report[/TD]
[/TR]
[TR]
[TD]Physician's report and request[/TD]
[/TR]
[TR]
[TD]Bill's old report[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

 

[hippiehacker]

Thanks again for sticking with me on this. see the example results below when I ran the program. It eliminated the problem with the 'S however, note that it won't cap any word following the one that contains the apostrophe.

BEFORE

[TABLE="width: 281"]
<tbody>[TR]
[TD]test report[/TD]
[/TR]
[TR]
[TD]big ol fat report[/TD]
[/TR]
[TR]
[TD]physician's report and request[/TD]
[/TR]
[TR]
[TD]bill's old report

AFTER

[TABLE="width: 281"]
<tbody>[TR]
[TD]Test Report[/TD]
[/TR]
[TR]
[TD]Big Ol Fat Report[/TD]
[/TR]
[TR]
[TD]Physician's report and request[/TD]
[/TR]
[TR]
[TD]Bill's old report[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

first search result in google return me the Ozgrid Page Change Text to Upper Case or Proper Case. Convert Text to Proper Case or Upper Case
and is exactly what you require.

 

[hiker95]

skyport,

1. What is the purpose of this project/exercise?

2. Is this some type of homework assignment?


Sample raw data (with the selection range A1:A5):

Excel 2007
	A
1	test report
2	big ol fat report
3	physician's report and request
4	bill's old report
5	physician's
6
Sheet1

After the new macro:

Excel 2007
	A
1	Test Report
2	Big Ol Fat Report
3	Physician's Report and Request
4	Bill's Old Report
5	Physician's
6
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ConvertSelectionUpper_V3()
' hiker95, 08/27/2014, ME800718
Dim c As Range, p As Long, h As String, hl As String, hm As String, eh As String
Application.ScreenUpdating = False
With Selection
  .Value = Evaluate("=if(len(" & .Address & "),substitute(proper(" & .Address & "),"" And "","" and ""),"""")")
  .Columns.AutoFit
End With
For Each c In Selection
  If InStr(c, "'") Then
    h = c
    p = WorksheetFunction.Find("'", c, 1)
    eh = Right(h, Len(h) - (p + 1))
    hl = Left(c, p)
    hm = LCase(Mid(h, p + 1, 1))
    c = hl & hm & eh
  End If
Next c
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConvertSelectionUpper_V3 macro.

 

[skyport]

Hi again Hiker,

The project is for some doctors I need to make a list for.

The last program resolved the indicated problem and at same time introduces one more as a side affect. Please see example below where it appears that the 'S problem comes up now on all words with apostrophes "only after the first word that contains apostrophe", which processes okay:

[TABLE="width: 392"]
<colgroup><col></colgroup><tbody>[TR]
[TD]BEFORE[/TD]
[/TR]
[TR]
[TD]physician's report and comment[/TD]
[/TR]
[TR]
[TD]doctor's comments and notes[/TD]
[/TR]
[TR]
[TD]physician's, nurse's and clinical doctor's report and comment[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]AFTER[/TD]
[/TR]
[TR]
[TD]Physician's Report and Comment[/TD]
[/TR]
[TR]
[TD]Doctor's Comments and Notes[/TD]
[/TR]
[TR]
[TD]Physician's and Doctor'S Report and Comment[/TD]
[/TR]
[TR]
[TD]Physician's, Nurse'S and Clinical Doctor'S Report and Comment[/TD]
[/TR]
</tbody>[/TABLE]

 

[hiker95]

skyport,

Sample raw data (with the selection range A1:A9):

Excel 2007
	A
1	physician's report and comment
2	doctor's comments and notes
3	physician's and doctor'd report and comment
4	physician's, nurse's and clinical doctor's report and comment
5	test report
6	big ol fat report
7	physician's report and request
8	bill's old report
9	physician's
10
Sheet1

After the new macro:

Excel 2007
	A
1	Physician's Report and Comment
2	Doctor's Comments and Notes
3	Physician's and Doctor'd Report and Comment
4	Physician's, Nurse's and Clinical Doctor's Report and Comment
5	Test Report
6	Big Ol Fat Report
7	Physician's Report and Request
8	Bill's Old Report
9	Physician's
10
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ConvertSelectionUpper_V4()
' hiker95, 08/27/2014, ME800718
Dim c As Range, s, i As Long, s2, h As String
Application.ScreenUpdating = False
With Selection
  .Value = Evaluate("=if(len(" & .Address & "),substitute(proper(" & .Address & "),"" And "","" and ""),"""")")
  .Columns.AutoFit
End With
For Each c In Selection
  h = ""
  If InStr(c, "'") Then
    s = Split(Trim(c), " ")
    For i = LBound(s) To UBound(s)
      If InStr(s(i), "'") Then
        s2 = Split(s(i), "'")
        h = h & s2(0) & "'" & LCase(s2(1)) & " "
      Else
        h = h + s(i) & " "
      End If
    Next i
    If Right(h, 1) = " " Then
      h = Left(h, Len(h) - 1)
    End If
    c = h
  End If
Next c
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConvertSelectionUpper_V4 macro.

 

[skyport]

Looks like we have a winner. I tried every variation of challenge I could think of to see if it would have a problem and I am happy to say it worked perfectly. Thanks so very much for sticking with it till the end.

 

[hippiehacker]

Looks like we have a winner. I tried every variation of challenge I could think of to see if it would have a problem and I am happy to say it worked perfectly. Thanks so very much for sticking with it till the end.

did you tried the code from ozgrid?

Sub ConvertCase()
Dim rAcells As Range, rLoopCells As Range
 'Set variable to needed cells
   Set rAcells = Selection
 For Each rLoopCells In rAcells
     rLoopCells = StrConv(rLoopCells, vbProperCase)
  Next rLoopCells
End Sub

I don't know how much would be the time difference ifyou want the error checks then check the full code on ozgrid.

 

[hiker95]

skyport,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[skyport]

Hippiehacker, I am not sure what ozgrid is

 

[skyport]

To Hippiehacker, I did try the program you suggested as well and am happy to say it works also. It was nice to have both solutions and I thank both of you for the help.