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

Thanks for all the help!

I didn't want to use that workaround, I also sought help from a tech-adjacent community, and I eventually came up with something that does everything I want done. For anyone else that might stumble across this thread who wants to make a similar VBA macro, the following code should be easy enough to use. Just substitute your target font name and symbols/unicode as required.

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