Option Explicit 
 
Function TranslateChar(StrIn As String) As String 
     
     ' This function may be used in Excel or Access, or in any VB/VBA project.
     
     ' Function evaluates an ANSI string that may have special characters, identified
     ' in the collection populated below.  If a special character is found, the function
     ' replaces that character with a designated replacement string (may be any number
     ' of characters).  There is no support for Unicode.
     
     ' The function conserves case, so if the special character is uppercase, then the
     ' first character of the replacement string will be uppercase as well.
     
     ' While the intent of this function is to "replace" characters with diacritical
     ' marks with their Roman alphabet equivalents (you should feel free to change the
     ' mapping below if you do not think it's right or it does not suit your purposes;
     ' I am no linguist).  However, you could use the code to replace any single ANSI
     ' character with whatever string you desire.
     
    Dim Counter As Long 
    Static coll As Collection 
    Dim Check As String 
    Dim WasLower As Boolean 
    Dim Letter As String 
     
     ' See if the collection exists.  The collection is set up as a static variable, so
     ' that it will persist between function calls; that will save a few cycles on later
     ' function calls as there will be no need to create and populate the collection again.
     ' There wil be no "Set coll = Nothing" to release the object variable, though; we
     ' will rely on VBA to clean up the collection object for us when the user exits the
     ' application
     
    If coll Is Nothing Then 
         
        Set coll = New Collection 
         
         ' Populate a Collection with the mapping.  The Key is the special character, and the
         ' Item is the replacement.  The key must always be a single character, but the item
         ' may be 1+ characters.  Use lower case in this list, and continue the list as
         ' needed.
         
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="a", Key:="?" 
        coll.Add Item:="ae", Key:="?" 
        coll.Add Item:="c", Key:="?" 
        coll.Add Item:="e", Key:="?" 
        coll.Add Item:="e", Key:="?" 
        coll.Add Item:="e", Key:="?" 
        coll.Add Item:="e", Key:="?" 
        coll.Add Item:="i", Key:="?" 
        coll.Add Item:="i", Key:="?" 
        coll.Add Item:="i", Key:="?" 
        coll.Add Item:="i", Key:="?" 
        coll.Add Item:="n", Key:="?" 
        coll.Add Item:="o", Key:="?" 
        coll.Add Item:="o", Key:="?" 
        coll.Add Item:="o", Key:="?" 
        coll.Add Item:="o", Key:="?" 
        coll.Add Item:="o", Key:="?" 
        coll.Add Item:="oe", Key:="?" 
        coll.Add Item:="ss", Key:="?" ' German sharp s
        coll.Add Item:="th", Key:="?" ' Old English eth
        coll.Add Item:="th", Key:="?" ' Old English thorn
        coll.Add Item:="u", Key:="?" 
        coll.Add Item:="u", Key:="?" 
        coll.Add Item:="u", Key:="?" 
        coll.Add Item:="u", Key:="?" 
        coll.Add Item:="y", Key:="?" 
        coll.Add Item:="y", Key:="?" 
         
         ' This entry is for illustration only!  You should remove before using!
        coll.Add Item:="dollar", Key:="$" 
         
    End If 
     
     ' Loop through string to look for special characters needing replacement
     
    For Counter = 1 To Len(StrIn) 
         
         ' Look in collection to see if the current character being considered is a "special"
         ' character
         
        On Error Resume Next 
        Letter = Mid(StrIn, Counter, 1) 
        Check = coll(Letter) 
         
         ' Check to see if original character was upper or lower case
         
        WasLower = (StrComp(Letter, LCase(Letter), vbBinaryCompare) = 0) 
         
         ' If there was no error, that means character was in collection and thus is a
         ' special character needing replacement
         
        If Err <> 0 Then 
            Err.Clear 
            Check = Letter 
        End If 
        On Error GoTo 0 
         
         ' If character was lower case, return the translation in lower case.  If upper case,
         ' return in proper case (first character capitalized)
         
        TranslateChar = TranslateChar & IIf(WasLower, LCase(Check), StrConv(Check, vbProperCase)) 
    Next 
     
End Function