Compare and replace- English and French Translation- Optimization.

[kitwit]

Hi,

Is there a way i can optimize this code below, when i run it on large set of values, it just freezes; this is compare and replace script from a dictionary list.

Option Explicit
Sub TranslateEngFr2()
    Dim rEngFr As Range, rEng As Range, r As Range, r2, InputRng As Range
    Dim iEng As Long
    Dim MyAdd$, xTitleId$
    
    Set InputRng = Application.Selection
    Set rEng = Application.InputBox("Convert Which text :", xTitleId, Type:=8)
    Set rEngFr = Application.InputBox("translation dictionary ", xTitleId, InputRng.Address, Type:=8)
    
    
    Application.ScreenUpdating = False
    
    For Each r In rEng.Cells
        For Each r2 In rEngFr.Rows
            If r.Value = r2.Cells(1, 1).Value Then
                r.Value = r2.Cells(1, 2).Value
                r.Interior.Color = vbGreen
                Exit For
            End If
        Next
    Next
    
    Application.ScreenUpdating = True


End Sub

[Paul_Hossler]

Starting point

Option Explicit


Sub TranslateEngFr2()
    Dim rEngFr As Range, rEng As Range, r As Range, r2, InputRng As Range
    Dim iEng As Long
    Dim MyAdd As String, xTitleId As String
    Dim oDic As Object
    
    Application.ScreenUpdating = False
    
    Set oDic = CreateObject("Scripting.Dictionary")
    oDic.CompareMode = vbTextCompare
    
    Set InputRng = Application.Selection
    
    'commented out for testing
'    Set rEng = Application.InputBox("Convert Which text :", xTitleId, Type:=8)
'    Set rEngFr = Application.InputBox("translation dictionary ", xTitleId, InputRng.Address, Type:=8)
    
    'added for testing
    Set rEng = ActiveSheet.Cells(1, 1).CurrentRegion
    Set rEngFr = ActiveSheet.Cells(1, 3).CurrentRegion
    
    For Each r In rEngFr.Rows
        On Error Resume Next
        'Eng is the key, Fr is the data
        oDic.Add r.Cells(1, 1).Value, r.Cells(1, 2).Value
        On Error GoTo 0
    Next
    
    For Each r In rEng.Cells
        If oDic.exists(r.Value) Then
            r.Value = oDic(r.Value)
            r.Interior.Color = vbGreen
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

[stefanoste78]

Sorry. Does the attached macro do the translation or something else? I do not seem to see words or a translation when I launch the macro

[Paul_Hossler]

You didn't provide any test materials so I made my own.

This was a only starting point to show one (of many) techniques -- I used a scripting dictionary approach.

I also saved some of my time for testing and demo by 'locking' the ranges, so remove the appropriate comment lines


In Before.jpg the blue in col A are the 'English' text to be translated, the blue in col C is the 'From English' word and the red in col D is the 'To French' word

In After.jpg, the green in col A are the original English words matched in col C replaced by the corresponding French words in col D


If you're looking for something different, then a sample workbook and more details will be helpful


Before.JPG After.JPG

[seshu]

Hi This is Seshu, i am new to this form.

I need help to Replace values in excel sheet, in a particular column.

please see below my requirement.

column name1

if column name1 = "ALL" or "PATI", then column name1="No", else column name1="Yes"