Change the format of individual characters per cell per range based on capitalization. Random Excel Errors

Question

Trying to make an abbreviated list for work. The first column lists abbreviations. The second column sets the abbreviation while maintaining the main components.

Ex. | POC | Point of contact |

The goal is to format the uppercase letters for easier viewing, making them bold, increasing the size, and changing the color to red.

Ex. | POC | P oint O f C ontact | ------------ Imagine the letters are red and large

Since I have more than 1,000 acronyms to work with, I created VBA code to check each character on a cell and format the correct ones. Below you can find my code.

Excel may handle some phrases while strangulation, and then crash on others. I tried to check the patterns, why no luck.

In other cases, Excel will act in unpredictable ways, such as duplicating the leading letter or highlighting the rest of the phrase in red. When comparing the text value in the formula bar versus what is visible in the cell, you can see the difference

Error example

These problematic cells tend to corrupt the file when saving and reopening.

Is there something inherently wrong with my code, or is Excel for some reason an error? Would there be another way to do this without causing excel errors and file corruption?

UPDATE: Another Example Error Executing Proposed Code

Sub Acronym_List_Formatting()
Dim cll As Range
Dim i As Long
Dim q As Integer
Dim Char As String
Dim UChar As String
Dim Phrase() As String

q = Application.InputBox("Set the base font size", Default:=12, Type:=1)

'| Set initial formatting of everything |'

With Selection.Font
    .Name = "Calibri"
    .Size = q
    .Bold = False
    .Color = vbBlack
End With

'| Main Code |'

For Each cll In Selection

ReDim Phrase(Len(cll.Value))

 For i = 1 To Len(cll.Value)

    Char = Mid$(cll.Value, i, 1)
    UChar = UCase$(Char)
    Phrase(i) = Char

   If Asc(UChar) >= 65 And Asc(UChar) <= 90 Then '|Asc returns the ASCII value ; Continues only if character is a letter|'

        If Char = UChar Then
            With cll.Characters(i, 1).Font
                    .Bold = True
                    .Size = .Size + 1.5
                    .Color = vbRed
            End With

        End If

   End If

   Next i

 'Debug.Print "Phrase: " & Join(Phrase)
 MsgBox ("Phrase: " & Join(Phrase, ""))

 Next cll

 End Sub

UPDATE (2): excerpt from my test data

Amcom [ ]

c2BmC [, ]

Bmds [ ] Opir [ ]

Jtids [ ]

[ ]

Osf [ ]

Patriot [ ] 3 SIMMAL

Patriot [ ] Anti-Cruise Missile

Patriot [ ]

RW []

Sm-3 [ -3]

[ - ] PACIFIC

THaad [ ]

Answer 1

, :

---

Option Explicit

Public Sub AcronymListFormatting()
    Dim fntSz As Variant, cll As Range, i As Long, char As String

    fntSz = Application.InputBox("Set the base font size", Default:=12, Type:=1)

    If fntSz <> False And fntSz > 7 Then    'validate user input and Cancel
        Application.ScreenUpdating = False
        With Selection.Font
            .Name = "Calibri"
            .Size = fntSz
            .Bold = False
            .Color = vbBlack
        End With
        For Each cll In Selection.Cells
            For i = 1 To Len(cll.Value2)
                char = Mid$(cll.Value2, i, 1)
                If Asc(char) >= 65 And Asc(char) <= 90 Then    'A-Z = 65-90, a-z = 97-122
                    With cll.Characters(i, 1).Font
                        .Bold = True
                        .Size = .Size + 1.5
                        .Color = vbRed
                    End With
                End If
            Next
        Next
        Application.ScreenUpdating = True
    End If
End Sub

---

---

:

cll.Value2 = WorksheetFunction.Proper(cll.Value2)

cll.Value2 = StrConv(cll.Value2, vbProperCase)

---

1

:

2

( ) , , P. McInturff .