excelvba

How to call a macro, to Convert Accented Characters to Regular, that does not appear in the list?


I am trying to replace accented characters with regular characters.

When I try to run the macro it doesn't appear in the list.

Option Explicit

'-- Add more chars to these 2 string as you want
'-- You may have problem with unicode chars that has code > 255
'-- such as some Vietnamese characters that are outside of ASCII code (0-255)
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Sub StripAccent(aRange As Range)
'-- Usage: StripAccent Sheet1.Range("A1:C20")
Dim A As String * 1
Dim B As String * 1
Dim i As Integer

For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
aRange.Replace What:=A, _
Replacement:=B, _
LookAt:=xlPart, _
MatchCase:=True
Next

End Sub

Solution

  • I do not see the option to run the macro in my macros list. The macro name is not appearing in the list to select. I have macros enabled and I have a bunch of others I use so I do not understand why it's not showing. – BvilleBullet 4 mins ago

    Please see the comment in the above code.

    '-- Usage: StripAccent Sheet1.Range("A1:C20")

    You have to call it like this

    Option Explicit
    
    '-- Add more chars to these 2 string as you want
    '-- You may have problem with unicode chars that has code > 255
    '-- such as some Vietnamese characters that are outside of ASCII code (0-255)
    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    
    '~~> This is how you have to call it. Now You can see the macro "Sample" in the list
    Sub Sample()
        StripAccent Sheet1.Range("A1:C20")
    End Sub
    
    Sub StripAccent(aRange As Range)
        '-- Usage: StripAccent Sheet1.Range("A1:C20")
        Dim A As String * 1
        Dim B As String * 1
        Dim i As Integer
    
        For i = 1 To Len(AccChars)
            A = Mid(AccChars, i, 1)
            B = Mid(RegChars, i, 1)
            aRange.Replace What:=A, _
            Replacement:=B, _
            LookAt:=xlPart, _
            MatchCase:=True
        Next
    End Sub