PDA

View Full Version : Change Case of Text in Excel



Admin
08-11-2011, 08:33 AM
Hi All,

Here is a procedure to change the case of text in Excel.


Sub ChangeCase()

'// Developed by Krishnakumar @ ExcelFox.com on 10-Aug-2011

Dim cType As Long
Dim r As Range
Dim strAddr As String
Dim txt As String
Dim i As Long
Dim n As Long
Dim Wrd As String
Dim a, x, j As Long

If WorksheetFunction.CountA(Selection) = 0 Then
MsgBox "No data in selected range : " & Selection.Address(0, 0)
Exit Sub
End If

On Error Resume Next
cType = Application.InputBox("Enter Type No" & vbCrLf & vbCrLf & _
"Type - 1: Proper Case" & vbTab & "Type - 2: UPPER CASE" & vbCrLf & _
"Type - 3: Sentence case" & vbTab & "Type - 4: small case", "Change Case")
On Error GoTo 0

If cType > 0 And cType <= 4 Then
strAddr = Selection.Address(0, 0)
If InStr(1, strAddr, ",") = 0 Then
a = Selection.Value
If IsArray(a) Then
For i = 1 To UBound(a, 1)
For n = 1 To UBound(a, 2)
If cType = 3 Then
a(i, n) = ProperCase(a(i, n))
Else
x = Split(a(i, n))
For j = 0 To UBound(x)
Wrd = x(j)
Select Case cType
Case 1: txt = txt & " " & Application.Proper(Wrd)
Case 2: txt = txt & " " & UCase(Wrd)
Case 4: txt = txt & " " & LCase(Wrd)
End Select
Next
a(i, n) = Mid$(txt, 2): txt = ""
End If
Next
Next
With Selection
.Cells(1, 1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
Else
x = Split(a)
If cType = 3 Then
a = ProperCase(a)
Else
For j = 0 To UBound(x)
Wrd = Trim$(x(j))
Select Case cType
Case 1: txt = txt & " " & Application.Proper(Wrd)
Case 2: txt = txt & " " & UCase(Wrd)
Case 4: txt = txt & " " & LCase(Wrd)
End Select
Next
a = Mid$(txt, 2): txt = ""
End If
With Selection
.Cells(1, 1) = a
End With
End If
Else
For Each r In Selection
If cType = 3 Then
r = ProperCase(r.Text)
Else
x = Split(r.Value)
For j = 0 To UBound(x)
Wrd = x(j)
Select Case cType
Case 1: txt = txt & " " & Application.Proper(Wrd)
Case 2: txt = txt & " " & UCase(Wrd)
Case 4: txt = txt & " " & LCase(Wrd)
End Select
Next
r = Mid$(txt, 2): txt = ""
End If
Next
End If
End If

End Sub

Private Function ProperCase(ByVal InputString As String) As String

Dim x, i As Long, Wrd As String, Pos As Long, j As Long, Aasc As Long

x = Split(InputString, ".")
InputString = Empty

For i = 0 To UBound(x)
Wrd = x(i)
Pos = 0
For j = 1 To Len(Wrd)
Aasc = Asc(Mid$(UCase$(Wrd), j, 1))
If Aasc >= 65 And Aasc <= 90 Then
Pos = j
Exit For
End If
Next
If Pos Then
If Len(InputString) Then
InputString = InputString & "." & UCase$(Left$(Wrd, Pos)) & LCase$(Mid$(Wrd, Pos + 1))
Else
InputString = UCase$(Left$(Wrd, Pos)) & LCase$(Mid$(Wrd, Pos + 1))
End If
Else
If Len(InputString) Then
InputString = InputString & "." & Wrd
Else
InputString = Wrd
End If
End If
Next

ProperCase = InputString

End Function


Select the range to change the case, run the macro ChangeCase.


Although Excel has 3 in-built functions to change the cases (PROPER, UPPER and LOWER), I hope this might also be a useful one :)