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 & "ppercase" & vbCr & _
"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