Excel Macro to replace accented chars with close e

Question

I have an Excel Macro that seems to work to replace some diacritic chars in a spreadsheet with the closest English equivalents.

I need to add more to the list of diacritics to search for.

I don't need an "authoritative/full" list (and the replacement chars), ideally just those commonly used in major European usage (umlauts, accents etc.)

I was hoping a programmer here would have a list of diacritics (or better, the VBA code, like mine, using them) that they commonly use in a programming language to give a better solution than in the code below.

Sub Replace_Diacritics()
    With Cells
        .Replace What:="á", Replacement:="a", MatchCase:=False
        .Replace What:="é", Replacement:="e", MatchCase:=False
        .Replace What:="í", Replacement:="i", MatchCase:=False
        .Replace What:="ó", Replacement:="o", MatchCase:=False
        .Replace What:="ú", Replacement:="u", MatchCase:=False
    End With
End Sub

Answer 1

The range of char codes 192..609 contains 221 char that are representable in ASCII (i. e. can be converted from diacritic chars):

À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö Ø Ù Ú Û Ü Ý à á â ã ä å æ ç è é ê ë ì í î ï ñ ò ó ô õ ö ø ù ú û ü ý ÿ Ā ā Ă ă Ą ą Ć ć Ĉ ĉ Ċ ċ Č č Ď ď Đ đ Ē ē Ĕ ĕ Ė ė Ę ę Ě ě Ĝ ĝ Ğ ğ Ġ ġ Ģ ģ Ĥ ĥ Ħ ħ Ĩ ĩ Ī ī Ĭ ĭ Į į İ ı Ĵ ĵ Ķ ķ Ĺ ĺ Ļ ļ Ľ ľ Ł ł Ń ń Ņ ņ Ň ň Ō ō Ŏ ŏ Ő ő Œ œ Ŕ ŕ Ŗ ŗ Ř ř Ś ś Ŝ ŝ Ş ş Š š Ţ ţ Ť ť Ŧ ŧ Ũ ũ Ū ū Ŭ ŭ Ů ů Ű ű Ų ų Ŵ ŵ Ŷ ŷ Ÿ Ź ź Ż ż Ž ž ƀ Ɖ Ƒ ƒ Ɨ ƚ Ɵ Ơ ơ ƫ Ʈ Ư ư ƶ Ǎ ǎ Ǐ ǐ Ǒ ǒ Ǔ ǔ Ǖ ǖ Ǘ ǘ Ǚ ǚ Ǜ ǜ Ǟ ǟ Ǥ ǥ Ǧ ǧ Ǩ ǩ Ǫ ǫ Ǭ ǭ ǰ ɡ

You can try the below simplest function, but it's drawback is that all Unicode chars, which are not representable in ASCII will be replaced with ?:

Function Replace_Diacritics(strText)
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Open
        .Charset = "ascii"
        .WriteText strText
        .Position = 0
        Replace_Diacritics = .ReadText
        .Close
    End With
End Function

Other one more complex function replaces only the chars, which are representable in ASCII, the rest chars are unchanged:

Function Replace_Diacritics(strText)

    Static objDict As Object
    Dim i, strRange, strCured, strChar, arrRes

    If objDict Is Nothing Then
        Set objDict = CreateObject("Scripting.Dictionary")
        strRange = ""
        For i = 192 To 609
            strRange = strRange & ChrW(i)
        Next
        With CreateObject("ADODB.Stream")
            .Type = 2
            .Mode = 3
            .Open
            .Charset = "ascii"
            .WriteText strRange
            .Position = 0
            strCured = .ReadText
            .Close
        End With
        For i = 192 To 609
            strChar = Mid(strCured, i - 191, 1)
            If strChar <> "?" Then objDict(ChrW(i)) = strChar
        Next
    End If

    arrRes = Array()
    ReDim arrRes(Len(strText))
    For i = 1 To Len(strText)
        strChar = Mid(strText, i, 1)
        If objDict.Exists(strChar) Then
            arrRes(i) = objDict(strChar)
        Else
            arrRes(i) = strChar
        End If
    Next
    Replace_Diacritics = Join(arrRes, "")

End Function