Another option...
Gives you all the options of Upper, Lower, Sentence, Title and smal
caps

something like.....


Code
-------------------

Option Explicit
'//
'// Amended code...thanks to Mike Leslie
'// 9th June 2003
'//

Sub TextCaseChange()
Dim RgText As Range
Dim oCell As Range
Dim Ans As String
Dim strTest As String
Dim sCap As Integer, _
lCap As Integer, _
i As Integer

'// You need to select a Range to Alter 1st!

Again:
Ans = Application.InputBox("[L]owercase" & vbCr & "[u]ppercase" & vbCr & _
"[S]entence" & vbCr & "[T]itles" & vbCr & "[C]apsSmall", _
"Type in a Letter", Type:=2)

If Ans = "False" Then Exit Sub
If InStr(1, "LUSTC", UCase(Ans), vbTextCompare) = 0 Or Len(Ans) 1 Then GoTo Again

On Error GoTo NoText
If Selection.Count = 1 Then
Set RgText = Selection
Else
Set RgText = Selection.SpecialCells(xlCellTypeConstants, 2)
End If
On Error GoTo 0

For Each oCell In RgText
Select Case UCase(Ans)
Case "L": oCell = LCase(oCell.Text)
Case "U": oCell = UCase(oCell.Text)
Case "S": oCell = UCase(Left(oCell.Text, 1)) & _
LCase(Right(oCell.Text, Len(oCell.Text) - 1))
Case "T": oCell = Application.WorksheetFunction.Proper(oCell.Text)
Case "C"
lCap = oCell.Characters(1, 1).Font.Size
sCap = Int(lCap * 0.85)
'Small caps for everything.
oCell.Font.Size = sCap
oCell.Value = UCase(oCell.Text)
strTest = oCell.Value
'Large caps for 1st letter of words.
strTest = Application.Proper(strTest)
For i = 1 To Len(strTest)
If Mid(strTest, i, 1) = UCase(Mid(strTest, i, 1)) Then
oCell.Characters(i, 1).Font.Size = lCap
End If
Next i
End Select
Next

Exit Sub
NoText:
MsgBox "No Text in your selection @ " & Selection.Address

End Sub

-------------------


-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com