MarkVrenken
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
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
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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