VBA Code for cell data language translation

Question

I'm writing a code to translate data from a selected cell from Portuguese to English, but I'm stuck with an error:

The translated cell is returning just "and" no matter what I write, it should translate all the words in a cell... Any ideas brilliant minds?

Here is my code:

Sub traducaobeta()

Dim translate As Object 'scritping.Dictionary

Set translate = CreateObject("Scripting.Dictionary")

translate("cadeira") = "chair"
translate("cadeiras") = "chairs"
translate("criado mudo") = "night stand"
translate("criado-mudo") = "night stand"
translate("mesa") = "table"
translate("mesas") = "tables"
translate(" e ") = " and "
' the list goes on...


Dim ptWords As String
Dim enWords As String

ptWords = LCase(activecell.Value)

For Each tempVar In translate.Keys()

enWords = Replace(Replace(CStr(tempVar), CStr(tempVar), translate(CStr(tempVar)), InStr(CStr(tempVar), CStr(tempVar))), " e ", " and ")

activecell.Offset(0, 1).Value = enWords

Next
End Sub

Anyone knows how to fix it?

Answer 1

I would try a loop through the words in your text instead. The following procedure translates every word that is found in your collection and leaves other words in portuguese:

Sub traducaobeta()

Dim translate As Object 'scritping.Dictionary

Set translate = CreateObject("Scripting.Dictionary")

translate("cadeira") = "chair"
translate("cadeiras") = "chairs"
translate("criado mudo") = "night stand"
translate("criado-mudo") = "night stand"
translate("mesa") = "table"
translate("mesas") = "tables"
translate(" e ") = " and "
' the list goes on...


Dim Words As Variant
Dim I As Integer
Words = Split(LCase(ActiveCell.Value))


For I = LBound(Words) To UBound(Words)
    If translate(Words(I)) <> "" Then Words(I) = translate(Words(I))
Next
ActiveCell.Offset(0, 1).Value = Join(Words)

End Sub