Forum Discussion
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.
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
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- I'm glad you found a solution.
Thank you for your feedback.
I wish you continued success with Excel!
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 Sub4. 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.
- 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.- I am glad that I could help you.
I wish you continued success with Excel!
