Need a macro code to Cap the first letter of words in entire columns

[skyport]

I have been using a code that had been working fine but with the new data I'm using it has a flaw. Below is first the actual code I'm currently using followed by an explanation of the flaw I am now encountering.


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


The program above generally works fine. The problem in using the current code above is when a word in the sentence is actually composed of all Caps such as an MRI or CT scan at a hospital. In such a case, the MRI or CT are originally entered as all caps however when the above code is run, it does successfully and properly cap the first letter of each word in each cell however MRI consequently ends up as Mri and CT as Ct, which is the problem. If there was some way to adjust the program above or another way to cap the first letters of all the words without disturbing those such as MRI or CT and others that were already entered in as caps. I am hoping somebody has a solution for this.

 

[Peter_SSs]

Try

Sub FirstCapitals()
  Dim Bits
  Dim i As Long
  Dim Cell As Range
  
  For Each Cell In Selection
    Bits = Split(Cell.Value)
    For i = 0 To UBound(Bits)
      Bits(i) = UCase(Left(Bits(i), 1)) & Mid(Bits(i), 2)
    Next i
    Cell.Value = Join(Bits)
  Next Cell
End Sub

 

[skyport]

Hi again Peter, You never fail to hit the bulls eye of the target, works perfect , thanks as always.

To: Caleeco and Hiker. I thank you both as well for the time and efforts and although Peter's solution completely solves the issue, if either or both of you wish to finish out any solutions you are working on, I will be most happy to give feedback on how they play out as this site should always be a giving back and forth as possible from all sides for a great experience to all.

Thanks again to all and long live the wonderful Mr. Excel that has been so helpful and special thanks to the Moderation always on top of the scene.

 

[Peter_SSs]

Hi again Peter, You never fail to hit the bulls eye of the target, works perfect , thanks as always.

Glad it was what you wanted.

 

[hiker95]

To: Caleeco and Hiker. I thank you both as well for the time and efforts and although Peter's solution completely solves the issue

skyport,

I am glad that Peter_SSs was able to solve your latest request.

Peter_SSs,

Nicely done, and, another one for my archives.

 

[Caleeco]

Hi Skyport,

I won't be finishing this code, as I have a personal VBA project to be getting on with and @Peter_SSs has provided an excellent piece of code!

Glad you got a solution to your problem.