Link to home
Start Free TrialLog in
Avatar of MarkVrenken
MarkVrenkenFlag for Netherlands

asked on

Excel: TranslateChar(StrIn as string) as string doesn't work for me

Dear experts,

In excel im trying to get this function from Matthewspatrick to work. If it works i think this is exactly what i would like to have! I am using excel 2010
 
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
    Dim coll As New 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

        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:="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:="E", Key:="È"
        coll.Add Item:="e", Key:="è"
        coll.Add Item:="E", Key:="É"
        coll.Add Item:="e", 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:="I", Key:="Î"
        coll.Add Item:="i", Key:="î"
        coll.Add Item:="I", Key:="Ï"
        coll.Add Item:="i", 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:="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:="O", Key:="Ø"
        coll.Add Item:="o", Key:="ø"
        coll.Add Item:="U", Key:="Ù"
        coll.Add Item:="u", Key:="ù"
        
        coll.Add Item:="U", Key:="Ú"
        coll.Add Item:="u", Key:="ú"
        coll.Add Item:="U", Key:="Ù"
        coll.Add Item:="u", Key:="ù"
        coll.Add Item:="U", Key:="Û"
        coll.Add Item:="u", Key:="û"
        coll.Add Item:="U", Key:="Ù"
        coll.Add Item:="u", Key:="ù"
        coll.Add Item:="U", Key:="Ü"
        coll.Add Item:="u", 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

Open in new window


I have put the function into a cell like: TranslateChar(D1)
in D1 there is a string like Øvre Røssaga and i want to get Ovre Rossaga.

I hope someone can help me,

Cheers,

MarkVrenken
ASKER CERTIFIED SOLUTION
Avatar of Patrick Matthews
Patrick Matthews
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of MarkVrenken

ASKER

Dear Patrick,

Thanks very much. I found the code on this site http://www.vbaexpress.com/kb/getarticle.php?kb_id=917
with your name as programmer, But thanks for your help!! i tested the function and it now works !

Thanks a lot i will mark your answer as solution.

Mark