Code to translate all workbook based on translation table

gubertu · Feb 24, 2019

Hi all,

I have a Workbook with one sheet called "Translation" with a translation table. There are 1.300 rows in this table, with words translated from English to Spanish, starting in cell "A1"

[TABLE="width: 500"]
<tbody>[TR]
[TD]English[/TD]
[TD]Spanish[/TD]
[/TR]
[TR]
[TD]Assets[/TD]
[TD]Activo[/TD]
[/TR]
[TR]
[TD]Liabilities[/TD]
[TD]Pasivo[/TD]
[/TR]
</tbody>[/TABLE]

What I need is a code that goes to every sheet and translate every word from English to Spanish.

I already have a code that do what I want, the problem is that for every sheet, the code checks the 1.300 rows of my translation table and then go to the next sheet and checks the 1.300 rows of my translation table and go to the next sheet, etc.

As I have 40 sheets, the process is taking to long and I´m looking for a way to do this quicker.

Any of you could improve this code or just give me another one that do what I need?

The code is the following.

Code:

Const lang1 As Long = 1    Const lang2 As Long = 2    Dim arr1    As Variant    Dim arr2    As Variant    Dim i       As Long    Dim lr      As Long    Dim ws      As Worksheet    Dim WS1 As Worksheet    Set WS1 = Sheets("Guide")            With ThisWorkbook.Worksheets("Translation")        lr = .Cells(.Rows.Count, 1).End(xlUp).Row        arr1 = .Range(.Cells(2, lang2), .Cells(lr, lang2))        arr2 = .Range(.Cells(2, lang1), .Cells(lr, lang1))    End With       For Each ws In ThisWorkbook.Worksheets        With ws            Select Case (ws.Name)                Case "Translation"                Case Else                    For i = 1 To lr - 1                        .Cells.SpecialCells(xlCellTypeConstants).Replace What:=arr1(i, 1), Replacement:=arr2(i, 1), LookAt:=xlWhole, _                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _                            ReplaceFormat:=False                    Next            End Select        End With    Next

I hope you could help me.

Thanks in advance!

Akuini · Feb 24, 2019

Here’s a suggestion:

Copy sheet "Translation" to another workbook then go back to your workbook.
Open replace dialog box (Ctrl+H) and set “Within” to “Workbook” then close it. This is to set the replace within all sheet all at once.
Revise your code so it won’t loop through sheet by sheet.
Also add “Application.ScreenUpdating = False” in the beginning of the code, and “Application.ScreenUpdating = True” in the end.
Run the code.
Copy back the sheet "Translation".

So basically you do the replace within the workbook (not sheet by sheet), it will be quicker but since the replace list has 3000 pair of words I think it’s still gonna be long.

gubertu · Feb 25, 2019

Many thanks for your help. I have one question.

Why I need to copy the sheet Translation to another WB? I have tried to do everything you proposed and still the process is too slow.

Thanks!

Akuini · Feb 25, 2019

Why I need to copy the sheet Translation to another WB?

Because if you do the replace in all sheet then the content of the sheet Translation will also be replaced, so you need to copy it first to another workbook & then copy it back.

I have tried to do everything you proposed and still the process is too slow.

How big is your data? How many rows in each sheet?
Can you show us your new code?

gubertu · Feb 26, 2019

Hello,

this is my full code. It is excluding the sheet "Translation" so I think I do not need to copy it in another WB. I also included ScreenUpdating and others codes to make it faster.

My WB has 40 sheets and the rows are different in every sheet. Not more than 250 rows in every sheet.

Hope you could help me.

Thanks!

Code:

Sub Change_language()
 
    
    Const lang1 As Long = 1
    Const lang2 As Long = 2
    Dim arr1    As Variant
    Dim arr2    As Variant
    Dim i       As Long
    Dim lr      As Long
    Dim ws      As Worksheet
    Dim WS1 As Worksheet
    Set WS1 = Sheets("Guide")
        
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


    With ThisWorkbook.Worksheets("Traslation")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr1 = .Range(.Cells(2, lang2), .Cells(lr, lang2))
        arr2 = .Range(.Cells(2, lang1), .Cells(lr, lang1))
    End With
    
   For Each ws In ThisWorkbook.Worksheets
        With ws
            Select Case (ws.Name)
                Case "Traslation"
                Case Else
                    For i = 1 To lr - 1
                        .Cells.SpecialCells(xlCellTypeConstants).Replace What:=arr1(i, 1), Replacement:=arr2(i, 1), LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                            ReplaceFormat:=False
                    Next
            End Select
        End With
    Next
    
Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False


End Sub

Akuini · Feb 26, 2019

Actually you missed the main point I mentioned earlier, i.e
• Revise your code so it won’t loop through sheet by sheet.

So again do these steps using the revised code below:
• Copy sheet "Translation" to another workbook then go back to your workbook.
• Open replace dialog box (Ctrl+H) and set “Within” to “Workbook” then close it. This is to set the replace within all sheet all at once.
• Run the code.
• Copy back the sheet "Translation".

Code:

[FONT=lucida console]
[COLOR=Royalblue]Sub[/COLOR] Change_language()
 
    
    [COLOR=Royalblue]Const[/COLOR] lang1 [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR] = [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Const[/COLOR] lang2 [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR] = [COLOR=crimson]2[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] arr1    [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Variant[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] arr2    [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Variant[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] i       [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] lr      [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
    [COLOR=Royalblue]Dim[/COLOR] ws      [COLOR=Royalblue]As[/COLOR] Worksheet
    [COLOR=Royalblue]Dim[/COLOR] WS1 [COLOR=Royalblue]As[/COLOR] Worksheet
[I][COLOR=seagreen]'    Set WS1 = Sheets("Guide")[/COLOR][/I]
        
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
Application.EnableEvents = [COLOR=Royalblue]False[/COLOR]
ActiveSheet.DisplayPageBreaks = [COLOR=Royalblue]False[/COLOR]


    [COLOR=Royalblue]With[/COLOR] ThisWorkbook.Worksheets([COLOR=brown]"Traslation"[/COLOR])
        lr = .Cells(.Rows.Count, [COLOR=crimson]1[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp).Row
        arr1 = .Range(.Cells([COLOR=crimson]2[/COLOR], lang1), .Cells(lr, lang2))
[I][COLOR=seagreen]'        arr2 = .Range(.Cells(2, lang1), .Cells(lr, lang1))[/COLOR][/I]
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]
    
                    [COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(arr1, [COLOR=crimson]1[/COLOR])
                        Cells.SpecialCells(xlCellTypeConstants).Replace What:=arr1(i, [COLOR=crimson]1[/COLOR]), Replacement:=arr1(i, [COLOR=crimson]2[/COLOR]), LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, MatchCase:=[COLOR=Royalblue]False[/COLOR], SearchFormat:=[COLOR=Royalblue]False[/COLOR], _
                            ReplaceFormat:=[COLOR=Royalblue]False[/COLOR]
                    [COLOR=Royalblue]Next[/COLOR]
    
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
Application.EnableEvents = [COLOR=Royalblue]True[/COLOR]
ActiveSheet.DisplayPageBreaks = [COLOR=Royalblue]True[/COLOR]
Application.CutCopyMode = [COLOR=Royalblue]False[/COLOR]


[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

gubertu · Mar 10, 2019

Hello,

I´ve been testing your code in the last few weeks and as I reduce some time, it is taking me 13 minutes to run all the code.

Do you know another way to translate a book of 40 sheets and 1.300 words in less time?

Thanks!

Akuini · Mar 10, 2019

My WB has 40 sheets and the rows are different in every sheet. Not more than 250 rows in every sheet

.
How many column do you have in each sheet?
The words to be replaced, are they only in certain column or in all column? If they are only in certain column then we can limit the search on that column.

Code to translate all workbook based on translation table

gubertu

Board Regular

Excel Facts

Akuini

Well-known Member

gubertu

Board Regular

Akuini

Well-known Member

gubertu

Board Regular

Akuini

Well-known Member

gubertu

Board Regular

Akuini

Well-known Member

Similar threads

Forum statistics

Share this page

Code to translate all workbook based on translation table

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock