Hi All,
Here is a procedure to change the case of text in Excel.
Code: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![]()




Reply With Quote

Bookmarks