Title Case Problems

[Jaye7]

<TABLE style="WIDTH: 522pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=696><COLGROUP><COL style="WIDTH: 522pt; mso-width-source: userset; mso-width-alt: 16197" width=696><TBODY><TR style="HEIGHT: 87.75pt; mso-height-source: userset" height=117><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 522pt; HEIGHT: 87.75pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl63 height=117 width=696>I use the following script for title case, however it doesn't work correctly as follows.

[FONT=Arial]Sub Test()[/FONT]
[FONT=Arial]For Each cell In Selection[/FONT]
[FONT=Arial]cell.Value = Application.WorksheetFunction.Proper(cell.Value)[/FONT]
[FONT=Arial]Next cell[/FONT]
[FONT=Arial]End Sub[/FONT]

Words that have an (') in them come out incorrectly as follows.

Initial dummy sentence.

title case has it's problems i'll, i've, doesn't

ends up as.

Title Case Has It'S Problems I'Ll, I'Ve, Doesn'T

Should end up as

Title Case Has It's Problems I'll, I've, Doesn't






</TD></TR></TBODY></TABLE>

 

[MARK858]

The built in Proper is known to have problems. Try this code from Ozgrid.

Sub ConvertCase()
    Dim rAcells As Range, rLoopCells As Range
    Dim lReply As Long
    'Set variable to needed cells
    If Selection.Cells.Count = 1 Then
        Set rAcells = ActiveSheet.UsedRange
    Else
        Set rAcells = Selection
    End If
    On Error Resume Next    'In case of NO text constants.
    'Set variable to all text constants
    Set rAcells = rAcells.SpecialCells(xlCellTypeConstants, xlTextValues)
    If rAcells Is Nothing Then
        MsgBox "Could not find any text."
        On Error GoTo 0
        Exit Sub
    End If
    lReply = MsgBox("Select 'Yes' for UPPER CASE or 'No' for Proper Case.", _
                    vbYesNoCancel, "OzGrid.com")
    If lReply = vbCancel Then Exit Sub
    If lReply = vbYes Then    ' Convert to Upper Case
        For Each rLoopCells In rAcells
            rLoopCells = StrConv(rLoopCells, vbUpperCase)
        Next rLoopCells
    Else    ' Convert to Proper Case
        For Each rLoopCells In rAcells
            rLoopCells = StrConv(rLoopCells, vbProperCase)
        Next rLoopCells
    End If

End Sub

 

[Jaye7]

Thanks Mark,

Works great, I simplified it for what I want to do.

Sub ConvertCase()
    Dim rAcells As Range, rLoopCells As Range
        Set rAcells = Selection
 
    Set rAcells = rAcells.SpecialCells(xlCellTypeConstants, xlTextValues)
 
       ' Convert to Proper Case
        For Each rLoopCells In rAcells
            rLoopCells = StrConv(rLoopCells, vbProperCase)
        Next rLoopCells
End Sub

 

[MARK858]

Glad it helped. Thanks for the feedback