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 :)
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 :)