kitwit
07-28-2018, 06:49 PM
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
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