Forum Discussion

Copper Contributor

Jun 08, 2023

Solved

Looking for a way to substitute all non-alphanumeric characters with specific font

I'm required to replace all symbols like degrees, multiplication sign, mu, alpha, etc., basically anything that isn't alphanumeric or brackets, that are in Times New Roman font with their equivalents in Symbol font. This is complicated by the limited character set of the Symbol font meaning that simply changing the font is insufficient - doing so sometimes results in an entirely different symbol.

Anyway, I have to do this hundreds of times a week, and it's pretty time-consuming, so if anyone has any tips on automating the process I'd be very grateful.

excel

Formulas and Functions

Macros and VBA

Benkyo

Jun 11, 2023

Thanks for all the help!

For anyone that might stumble across this thread in the future wanting to do the same thing (replace specific characters with another font), here's what I finally came up. Tested and works well.

Sub SymbolSubstitution()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
        
    Application.ScreenUpdating = False
        
    ' Find range to search over.
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    ' Loop over cells in range.
    For Each cell In rng3
        ' Only check non-empty cells.
        If cell.Value <> "" Then


            Call ConvertToSymbolAndReplace(cell, "Δ", "D")
            Call ConvertToSymbolAndReplace(cell, "Φ", "F")
            Call ConvertToSymbolAndReplace(cell, "Ω", "W")
            Call ConvertToSymbolAndReplace(cell, "α", "a")
            Call ConvertToSymbolAndReplace(cell, "β", "b")
            Call ConvertToSymbolAndReplace(cell, "χ", "c")
            Call ConvertToSymbolAndReplace(cell, "δ", "d")
            Call ConvertToSymbolAndReplace(cell, "ε", "e")
            Call ConvertToSymbolAndReplace(cell, "η", "h")
            Call ConvertToSymbolAndReplace(cell, "φ", "j")
            Call ConvertToSymbolAndReplace(cell, "λ", "l")
            Call ConvertToSymbolAndReplace(cell, "μ", "m")
            Call ConvertToSymbolAndReplace(cell, "π", "p")
            Call ConvertToSymbolAndReplace(cell, "θ", "q")
            Call ConvertToSymbolAndReplace(cell, "×", "´")
            Call ConvertToSymbol(cell, "~")
            Call ConvertToSymbol(cell, "&")
            Call ConvertToSymbol(cell, "+")
            Call ConvertToSymbol(cell, "%")
            Call ConvertToSymbol(cell, "<")
            Call ConvertToSymbol(cell, "=")
            Call ConvertToSymbol(cell, ">")
            Call ConvertToSymbol(cell, "°")
            Call ConvertToSymbol(cell, "±")
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Bullet (must run after × to ´)
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' Less than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' Greater than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Delta sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6) ' Function sign

        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Sub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)

    Dim charPos As Long
    
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = outputChar
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop
    
End Sub

Sub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop

End Sub

Sub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

8 Replies

Benkyo

Copper Contributor

Jun 11, 2023

Thanks for all the help!

For anyone that might stumble across this thread in the future wanting to do the same thing (replace specific characters with another font), here's what I finally came up. Tested and works well.

Sub SymbolSubstitution()

    Dim rng1, rng2, rng3 As Range
    Dim newText As String
        
    Application.ScreenUpdating = False
        
    ' Find range to search over.
    Set rng1 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)
    Set rng2 = Cells.Find("*", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)
    If Not rng1 Is Nothing Then
        Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))
    Else
        MsgBox "Worksheet is empty", vbExclamation, "Error"
        Exit Sub
    End If
        
    ' Loop over cells in range.
    For Each cell In rng3
        ' Only check non-empty cells.
        If cell.Value <> "" Then


            Call ConvertToSymbolAndReplace(cell, "Δ", "D")
            Call ConvertToSymbolAndReplace(cell, "Φ", "F")
            Call ConvertToSymbolAndReplace(cell, "Ω", "W")
            Call ConvertToSymbolAndReplace(cell, "α", "a")
            Call ConvertToSymbolAndReplace(cell, "β", "b")
            Call ConvertToSymbolAndReplace(cell, "χ", "c")
            Call ConvertToSymbolAndReplace(cell, "δ", "d")
            Call ConvertToSymbolAndReplace(cell, "ε", "e")
            Call ConvertToSymbolAndReplace(cell, "η", "h")
            Call ConvertToSymbolAndReplace(cell, "φ", "j")
            Call ConvertToSymbolAndReplace(cell, "λ", "l")
            Call ConvertToSymbolAndReplace(cell, "μ", "m")
            Call ConvertToSymbolAndReplace(cell, "π", "p")
            Call ConvertToSymbolAndReplace(cell, "θ", "q")
            Call ConvertToSymbolAndReplace(cell, "×", "´")
            Call ConvertToSymbol(cell, "~")
            Call ConvertToSymbol(cell, "&")
            Call ConvertToSymbol(cell, "+")
            Call ConvertToSymbol(cell, "%")
            Call ConvertToSymbol(cell, "<")
            Call ConvertToSymbol(cell, "=")
            Call ConvertToSymbol(cell, ">")
            Call ConvertToSymbol(cell, "°")
            Call ConvertToSymbol(cell, "±")
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Bullet (must run after × to ´)
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' Less than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' Greater than or equal sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Delta sign
            Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6) ' Function sign

        End If
    Next cell
       
    Application.ScreenUpdating = True

End Sub

Sub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)

    Dim charPos As Long
    
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = outputChar
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop
    
End Sub

Sub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, inputChar)
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, inputChar)
    Loop

End Sub

Sub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)

    Dim charPos As Long
    charPos = InStr(thisCell.Value, ChrW(inputCharCode))
    
    Do While charPos > 0
        thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)
        thisCell.Characters(charPos, 1).Font.Name = "Symbol"
        charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))
    Loop

End Sub

NikolinoDE
Gold Contributor
Jun 12, 2023
I'm glad you found a solution.
Thank you for your feedback.
I wish you continued success with Excel!

NikolinoDE
Gold Contributor
Jun 08, 2023
Benkyo
To automate the process of replacing non-alphanumeric characters with specific font formatting in Excel, you can use a combination of the SUBSTITUTE function and conditional formatting. Here's a step-by-step guide:
Identify the non-alphanumeric characters that you want to replace with specific font symbols.
Choose a column where you want to perform the replacement. Let's assume it's Column A.
In an empty column (e.g., Column B), enter the SUBSTITUTE function to replace the non-alphanumeric characters with specific symbols. For example, if the original text is in cell A1, you can use the following formula in cell B1:
=SUBSTITUTE(A1,"°","°")
Replace "°" with the non-alphanumeric character you want to replace, and "°" with the corresponding symbol from the Symbol font. Repeat this formula for all the non-alphanumeric characters you want to replace.
Copy the formula in Column B and paste it down to cover all the cells in Column B corresponding to your data in Column A.
Select the entire range in Column B.
Go to the Home tab in the Excel ribbon and click on Conditional Formatting.
Choose New Rule and select "Format only cells that contain."
In the Rule Description section, choose "Cell Value" as the rule, then select "Equal to" from the drop-down.
In the next field, enter a non-alphanumeric character that you want to format (e.g., "°").
Click on the Format button and go to the Font tab.
Choose the Symbol font and click OK to apply the formatting.
Repeat steps 7 to 11 for each non-alphanumeric character you want to format.
Click OK to apply the conditional formatting.
Now, any cell in Column B that contains the specified non-alphanumeric character will be formatted with the Symbol font. This allows you to see the equivalent symbol in place of the non-alphanumeric character while keeping the original text intact in Column A.
Please note that this method assumes you have a limited number of non-alphanumeric characters to replace. If you have a large number of different characters to replace, a VBA macro might be a more efficient solution.
Here's an example of how you can do it:
Press Alt+F11 to open the Visual Basic for Applications (VBA) editor.
Insert a new module by clicking on "Insert" > "Module."
In the module window, write the following VBA code:
Sub ReplaceCharactersWithSymbols() Dim rng As Range Dim cell As Range Dim originalText As String Dim modifiedText As String ' Set the range where your data is located Set rng = Range("A1:A100") ' Update the range as per your data ' Loop through each cell in the range For Each cell In rng ' Get the original text from the cell originalText = cell.Value modifiedText = originalText ' Replace the characters with their corresponding symbols modifiedText = Replace(modifiedText, "°", "°") modifiedText = Replace(modifiedText, "×", "×") modifiedText = Replace(modifiedText, "μ", "μ") ' Add more Replace statements for each character you want to replace ' Update the cell value with the modified text cell.Value = modifiedText Next cell End Sub
4. Customize the code to fit your needs:
Update the range Set rng = Range("A1:A100") to match the range where your data is located.
Add more Replace statements for each character you want to replace. Replace the first argument with the character you want to replace, and the second argument with the corresponding symbol from the Symbol font.
5. Close the VBA editor.
6.To run the macro, press Alt+F8 to open the "Macro" dialog box, select the macro name (ReplaceCharactersWithSymbols), and click "Run."
This VBA macro will loop through the specified range and replace the characters with their corresponding symbols using the Replace function. Make sure to adjust the range and add more Replace statements as needed for your specific characters.

Note: Before running the macro, it's recommended to make a backup of your data or test it on a sample dataset to ensure it produces the desired results.
- Benkyo
  Copper Contributor
  Jun 08, 2023
  Wow, that's quite an answer!
  
  Never used VBA before, but it looks like you have given me more than enough to get started. This was really helpful, thank you.
  - NikolinoDE
    Gold Contributor
    Jun 08, 2023
    I am glad that I could help you.
    I wish you continued success with Excel!

Resources

Sub SymbolSubstitution()\n\n Dim rng1, rng2, rng3 As Range\n Dim newText As String\n \n Application.ScreenUpdating = False\n \n ' Find range to search over.\n Set rng1 = Cells.Find(\"*\", [a1], xlFormulas, xlPart, xlByRows, xlPrevious)\n Set rng2 = Cells.Find(\"*\", [a1], xlFormulas, xlPart, xlByColumns, xlPrevious)\n If Not rng1 Is Nothing Then\n Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))\n Else\n MsgBox \"Worksheet is empty\", vbExclamation, \"Error\"\n Exit Sub\n End If\n \n ' Loop over cells in range.\n For Each cell In rng3\n ' Only check non-empty cells.\n If cell.Value <> \"\" Then\n\n\n Call ConvertToSymbolAndReplace(cell, \"Δ\", \"D\")\n Call ConvertToSymbolAndReplace(cell, \"Φ\", \"F\")\n Call ConvertToSymbolAndReplace(cell, \"Ω\", \"W\")\n Call ConvertToSymbolAndReplace(cell, \"α\", \"a\")\n Call ConvertToSymbolAndReplace(cell, \"β\", \"b\")\n Call ConvertToSymbolAndReplace(cell, \"χ\", \"c\")\n Call ConvertToSymbolAndReplace(cell, \"δ\", \"d\")\n Call ConvertToSymbolAndReplace(cell, \"ε\", \"e\")\n Call ConvertToSymbolAndReplace(cell, \"η\", \"h\")\n Call ConvertToSymbolAndReplace(cell, \"φ\", \"j\")\n Call ConvertToSymbolAndReplace(cell, \"λ\", \"l\")\n Call ConvertToSymbolAndReplace(cell, \"μ\", \"m\")\n Call ConvertToSymbolAndReplace(cell, \"π\", \"p\")\n Call ConvertToSymbolAndReplace(cell, \"θ\", \"q\")\n Call ConvertToSymbolAndReplace(cell, \"×\", \"´\")\n Call ConvertToSymbol(cell, \"~\")\n Call ConvertToSymbol(cell, \"&\")\n Call ConvertToSymbol(cell, \"+\")\n Call ConvertToSymbol(cell, \"%\")\n Call ConvertToSymbol(cell, \"<\")\n Call ConvertToSymbol(cell, \"=\")\n Call ConvertToSymbol(cell, \">\")\n Call ConvertToSymbol(cell, \"°\")\n Call ConvertToSymbol(cell, \"±\")\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2219, &HD7) ' Bullet (must run after × to ´)\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2211, &H53) ' Sum/sigma sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2212, &H2D) ' Minus sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2264, &HA3) ' Less than or equal sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2265, &HB3) ' Greater than or equal sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H221A, &HD6) ' Square root sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H221E, &HA5) ' Infinity sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H222B, &HF2) ' Integral sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H2206, &H44) ' Alternative Delta sign\n Call ConvertToSymbolAndReplaceUnicode(cell, &H192, &HA6) ' Function sign\n\n End If\n Next cell\n \n Application.ScreenUpdating = True\n\nEnd Sub\n\nSub ConvertToSymbolAndReplace(ByRef thisCell As Variant, ByVal inputChar As String, ByVal outputChar As String)\n\n Dim charPos As Long\n \n charPos = InStr(thisCell.Value, inputChar)\n \n Do While charPos > 0\n thisCell.Characters(charPos, 1).Text = outputChar\n thisCell.Characters(charPos, 1).Font.Name = \"Symbol\"\n charPos = InStr(charPos + 1, thisCell.Value, inputChar)\n Loop\n \nEnd Sub\n\nSub ConvertToSymbol(ByRef thisCell As Variant, ByVal inputChar As String)\n\n Dim charPos As Long\n charPos = InStr(thisCell.Value, inputChar)\n \n Do While charPos > 0\n thisCell.Characters(charPos, 1).Font.Name = \"Symbol\"\n charPos = InStr(charPos + 1, thisCell.Value, inputChar)\n Loop\n\nEnd Sub\n\nSub ConvertToSymbolAndReplaceUnicode(ByRef thisCell As Variant, ByVal inputCharCode As Long, ByVal outputCharCode As Long)\n\n Dim charPos As Long\n charPos = InStr(thisCell.Value, ChrW(inputCharCode))\n \n Do While charPos > 0\n thisCell.Characters(charPos, 1).Text = ChrW(outputCharCode)\n thisCell.Characters(charPos, 1).Font.Name = \"Symbol\"\n charPos = InStr(charPos + 1, thisCell.Value, ChrW(inputCharCode))\n Loop\n\nEnd Sub

Sub ReplaceCharactersWithSymbols()\n Dim rng As Range\n Dim cell As Range\n Dim originalText As String\n Dim modifiedText As String\n \n ' Set the range where your data is located\n Set rng = Range(\"A1:A100\") ' Update the range as per your data\n \n ' Loop through each cell in the range\n For Each cell In rng\n ' Get the original text from the cell\n originalText = cell.Value\n modifiedText = originalText\n \n ' Replace the characters with their corresponding symbols\n modifiedText = Replace(modifiedText, \"°\", \"°\")\n modifiedText = Replace(modifiedText, \"×\", \"×\")\n modifiedText = Replace(modifiedText, \"μ\", \"μ\")\n ' Add more Replace statements for each character you want to replace\n \n ' Update the cell value with the modified text\n cell.Value = modifiedText\n Next cell\nEnd Sub