Change to upper case without changing the font format

[praveenpatel421983]

Hi all,

I working on a spreadsheet which contains columns with strings. These strings are entered by different users. I need these columns to be in upper case always due to some reasons. But when I use code to change it, everything turns into uppercase but format of text is gone.
eg: "This item is used in Product X" should become "THIS ITEM IS USED IN PRODUCT X" instead it becomes "THIS ITEM IS USED IN PRODUCT X". Words which are made bold with increased font size is not followed.

I went to many posts but couldn't find the solution. I used below code. Please let me know what to change in this

Private Sub Worksheet_Activate()
    Range("A1:AF300") = [index(upper(A1:AF300),)]
End Sub

I also used this. this also didn't work

Private Sub Worksheet_Activate()   
   For Each x In Range("A1:AF300")
      x.Value = UCase(x.Value)
   Next
End Sub

Please help

Thanks in advance!
Praveen

 

[Yongle]

Try this

Sub ChangeCaseOnly()
    Dim cel As Range, Chars As Integer, Asci As Integer 
    For Each cel In Range("A1:AF300")
        With cel
            For Chars = 1 To Len(.Text)
                Asci = Asc(Mid(.Text, Chars, 1))
                    If Asci < 123 And Asci > 96 Then .Characters(Chars, 1).Text = Chr(Asci - 32)
            Next Chars
        End With
    Next cel
End Sub

 

[Akuini]

Try this on a small sample first, since the code will loop each character in the cell it will take a long time to finish in a big data.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1086999a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1086999-change-upper-case-without-changing-font-format.html[/COLOR][/I]

[COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] Range([COLOR=brown]"A1:A10"[/COLOR])
    [COLOR=Royalblue]For[/COLOR] k = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] Len(r)
        [COLOR=Royalblue]With[/COLOR] r.Characters(k, [COLOR=crimson]1[/COLOR])
             .[COLOR=Royalblue]Text[/COLOR] = UCase(.[COLOR=Royalblue]Text[/COLOR])
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[praveenpatel421983]

Thank you Yongle and Akuini for the reply. I tried Yongle's code and it worked fine.

 

[Yongle]

Thnaks for your feedback

 

[praveenpatel421983]

Sorry I had to come back on the post again. Yongle your code worked fine until now. For some reason it is not working for a cell which has bigger paragraph. I tried splitting that paragraph into smaller sentences and it worked for that but it didn't work for that big paragraph. I was not able to figure out what was the problem. Can you please help?

 

[praveenpatel421983]

I figured out it is doing till 255th character not sure why

 

[Yongle]

255 tells us that an Excel limit has been breached (255 is the maximum value of an 8 digit binary number ie binary number 11111111 - it was the limit in many areas in Excel)

(some current limits https://support.office.com/en-us/ar...d-limits-1672b34d-7043-467e-8e27-269d656771c3)

I will try to find a workaround tomorrow

 

[Yongle]

The workaround is to reapply current text formatting character by character

- create an array to capture the font size for each character in a cell
- convert text to upper case
- apply captured font size to text (one character at a time)

NOTE : The technique would need extending if there anything other than font size differs between characters
(capture all values first, then convert to upper case, then apply captured values)

Sub ChangeCaseAndMaintainFontSize()
        Application.ScreenUpdating = False
    Dim cel As Range, Chars As Long, T1 As String
    Dim arr() As Integer
    For Each cel In Range("A1:AF300")
        T1 = cel.Text
'create array of font sizes
        ReDim arr(1 To Len(T1))
        For Chars = 1 To Len(T1)
            arr(Chars) = cel.Characters(Chars, 1).Font.Size
        Next
'change to upper case
        cel = UCase(T1)
'apply font size from array
        For Chars = 1 To Len(T1)
            cel.Characters(Chars, 1).Font.Size = arr(Chars)
        Next
        Erase arr
    Next cel
End Sub

 

[Yongle]

above modified to take account of empty cells and font sizes that are not whole numbers

Sub ChangeCaseAndMaintainFontSize()
    Application.ScreenUpdating = False
    Dim cel As Range, Chars As Long, T1 As String
    Dim arr() [COLOR=#ff0000]As Double[/COLOR]
    For Each cel In Range("E1:E10")
        T1 = cel.Text
'create array of font sizes
        [COLOR=#ff0000]If Len(T1) > 0 Then[/COLOR]
            ReDim arr(1 To Len(T1))
                For Chars = 1 To Len(T1)
                arr(Chars) = cel.Characters(Chars, 1).Font.Size
            Next
'change to upper case
            cel = UCase(T1)
'apply font size from array
            For Chars = 1 To Len(T1)
                cel.Characters(Chars, 1).Font.Size = arr(Chars)
            Next
            Erase arr
        [COLOR=#ff0000]End If[/COLOR]
    Next cel
End Sub