xl vba udf translate text

'VBA function (extremely fast) to force an array column 
'to ONLY alpha-numeric characters (with spaces):

Function ForceArrayColumnAlphaNumeric(v, Optional col& = 1)
    Dim i&, j&, p&, max&, t&
    Dim b() As Byte, res() As Byte, Keep(0 To 255) As Boolean

    Const VALS$ = "0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
    
    For j = 1 To Len(VALS)
        Keep(Asc(Mid$(VALS, j, 1))) = 1
    Next
    
    For i = LBound(v) To UBound(v)
        p = 0
        max = Len(v(i, col))
        ReDim res(0 To max)
        b = StrConv(v(i, col), vbFromUnicode)
        For j = 0 To max - 1
            t = b(j)
            If Keep(t) Then
                res(p) = t
                p = p + 1
            End If
        Next
        v(i, col) = StrConv(res, vbUnicode)
    Next
End Function

'----------------------------------------------------------------------------------

array = [A1:Z999].Value2
ForceArrayColumnAlphaNumeric array, 3 '<--the 3rd column of array is now cleansed


'NB: Adjust the VALS$ constant to include only the characters you want to keep.
'NB: Array must be 2D. The column cleansed defaults to column 1.

View another examples Add Own solution

3.83

Kundor 80 points

                                    'Here is a VBA User Defined Function to translate text in an Excel cell. It 
'uitlizes Google Translate and thus requires an Internet connection:

Function Translate$(sText$, FromLang$, ToLang$)
    Dim p1&amp;, p2&amp;, url$, resp$
    Const DIV_RESULT$ = &quot;&lt;div class=&quot;&quot;result-container&quot;&quot;&gt;&quot;
    Const URL_TEMPLATE$ = &quot;https://translate.google.com/m?hl=[from]&amp;sl=[from]&amp;tl=[to]&amp;ie=UTF-8&amp;prev=_m&amp;q=&quot;
    url = URL_TEMPLATE &amp; WorksheetFunction.EncodeURL(sText)
    url = Replace(url, &quot;[to]&quot;, ToLang)
    url = Replace(url, &quot;[from]&quot;, FromLang)
    resp = WorksheetFunction.WebService(url)
    p1 = InStr(resp, DIV_RESULT)
    If p1 Then
        p1 = p1 + Len(DIV_RESULT)
        p2 = InStr(p1, resp, &quot;&lt;/div&gt;&quot;)
        Translate = Mid$(resp, p1, p2 - p1)
    End If
End Function

'------------------------------------------------------------------------------

'With the following text in cell A1: Every moment is a fresh beginning.

'In cell B1, enter this formula:

=Translate(A1, &quot;en&quot;, &quot;fr&quot;)    '&lt;--translates text in A1 from English to French.

'The result in cell B1 will be: Chaque instant est un nouveau d&eacute;part.


'Of course the Translate() function can be used directly from VBA as well:

MsgBox Translate([A1], &quot;en&quot;, &quot;de&quot;)  '&lt;--displays: Jeder Moment ist ein Neuanfang.


'And of course you may also manually use the Translate functionality 
'built into Excel, which can be found on the Review tab of the 
'Ribbon. But the UDF above provides a quick and streamlined method 
'to translate text programmatically. Excel's translation capability 
'is not exposed via the Excel Object Model, so a function like the 
'above can be quite useful.


'The &quot;FromLang&quot; and &quot;ToLang&quot; arguments must be codes from the following table:

' CODE   LANGUAGE
' en	 English
' fr	 French
' es	 Spanish
' it     Italian
' de     German
' af	 Afrikaans
' sq	 Albanian
' am	 Amharic
' ar	 Arabic
' hy	 Armenian
' az	 Azerbaijani
' eu	 Basque
' be	 Belarusian
' bn	 Bengali
' bs	 Bosnian
' bg	 Bulgarian
' ca	 Catalan
' ceb    Cebuano
' ny	 Chichewa
' zh-CN  Chinese (Simplified)
' zh-TW  Chinese (Traditional)
' co	 Corsican
' hr	 Croatian
' cs	 Czech
' da	 Danish
' nl	 Dutch
' eo	 Esperanto
' et	 Estonian
' tl	 Filipino
' fi	 Finnish
' fy	 Frisian
' gl	 Galician
' ka	 Georgian
' el	 Greek
' gu	 Gujarati
' ht	 Haitian Creole
' ha	 Hausa
' haw    Hawaiian
' iw	 Hebrew
' hi	 Hindi
' hmn    Hmong
' hu	 Hungarian
' is	 Icelandic
' ig	 Igbo
' id	 Indonesian
' ga	 Irish
' ja	 Japanese
' jw	 Javanese
' kn	 Kannada
' kk	 Kazakh
' km	 Khmer
' rw	 Kinyarwanda
' ko	 Korean
' ku	 Kurdish (Kurmanji)
' ky	 Kyrgyz
' lo	 Lao
' la	 Latin
' lv	 Latvian
' lt	 Lithuanian
' lb	 Luxembourgish
' mk	 Macedonian
' mg	 Malagasy
' ms	 Malay
' ml	 Malayalam
' mt	 Maltese
' mi	 Maori
' mr	 Marathi
' mn	 Mongolian
' my	 Myanmar (Burmese)
' ne	 Nepali
' no	 Norwegian
' or	 Odia (Oriya)
' ps	 Pashto
' fa	 Persian
' pl	 Polish
' pt	 Portuguese
' pa	 Punjabi
' ro	 Romanian
' ru	 Russian
' sm	 Samoan
' gd	 Scots Gaelic
' sr	 Serbian
' st	 Sesotho
' sn	 Shona
' sd	 Sindhi
' si	 Sinhala
' sk	 Slovak
' sl	 Slovenian
' so	 Somali
' su	 Sundanese
' sw	 Swahili
' sv	 Swedish
' tg	 Tajik
' ta	 Tamil
' tt	 Tatar
' te	 Telugu
' th	 Thai
' tr	 Turkish
' tk	 Turkmen
' uk	 Ukrainian
' ur	 Urdu
' ug	 Uyghur
' uz	 Uzbek
' vi	 Vietnamese
' cy	 Welsh
' xh	 Xhosa
' yi	 Yiddish
' yo	 Yoruba
' zu	 Zulu
'
'
'

Thank you! 6