Replace multiple words in Excel sheet - excel

Question

Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") ' contains the data
Set s2 = Sheets("Sheet2") ' contains the translation table
s2.Activate
N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
from(i) = Cells(i, 1).Value
too(i) = Cells(i, 2).Value
Next i
s1.Activate
' -------------- Modification starts here --------------------------
' Replace from from(i) to __MYREPLACEMENTi__ (where i is the counter)
For i = LBound(from) To UBound(from)
Cells.Replace What:=from(i), Replacement:="__MYREPLACEMENT" + Str(i) + "__"
Next i
' Replace from __MYREPLACEMENTi__ to too(i) (where i is the counter)
For i = LBound(from) To UBound(from)
Cells.Replace What:="__MYREPLACEMENT" + Str(i) + "__", Replacement:=too(i)
Next i
' -------------- Modification ends here --------------------------
End Sub
I am using above code to find and replace multiple words (in "Column A Sheet1" with words in "Column B Sheet 2") in below mentioned sheet:
https://docs.google.com/spreadsheets/d/14ba9pQDjMPWJd4YFpGffhtVcHxml0LdUUVQ0prrOEUY/edit?usp=sharing
However when I apply this in another sheet (as mentioned below) for another data then code fails i.e. I get distorted words in sheet1:
https://docs.google.com/spreadsheets/d/1spvZAzxT1kB1bytCQaNQH7tl1DJSpLITYgW6P5dxbQE/edit?usp=sharing
Please help me out so that I can replace words in "Column A Sheet1" with words in "Column B Sheet2"
Note: Above links have been given of google spreadsheet however I am having problem in Excel 2007 sheet.
I request you to help me by giving whole revised code as I am not good in VBA

Answer 1

I agree with sous2817: the more you solve your own problems, the faster you will develop. However, I think a little advice will help.
You must learn VBA if you are going to use it. Finding, and attempting to use, a piece of code which you do not understand is never going to end well. This is particularly true when the author of this code only knows a little more than you.
Search the web for "Excel VBA Tutorial". There are many to choose from so try a few and complete one that matches your learning style. I prefer books. I visited a large library, reviewed their Excel VBA Primers and borrowed those I liked. After trying them out at home, I bought the one that suited me best.
Where did you get this code? It contains typical beginner mistakes and it does not work even with the first example.
The first word in Sheet1 is "it". Sheet2 indicates "it" is to be replaced by "that". The code correctly replaces "it" by "that" Unfortunately, it replaces all "it"s by "that"s so "with" is translated to "wthath" not "having". Since you complain about the second pair of sheets, I assume you did not notice that mistranslation. Such mistranslations will be must more obvious in the second pair with the first word "the" appearing in "they", "there", "their", "them", "then" and "these".
If you look up the Replace Method, you should see a quick correction to this error. Note: Replace Method not Replace Function.
I will end by giving a couple examples of how a less junior programmer might have coded this routine.
Consider:
s2.Activate
N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
from(i) = Cells(i, 1).Value
too(i) = Cells(i, 2).Value
Next i
One of the first things you learn when you start learning VBA is “Do not activate worksheets or select cells”. These are slow commands and even if you use ScreenUpdating = False there will be some screen rewriting. More importantly, your code can become very confusing. The following is better:
With s2
N = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
from(i) = .Cells(i, 1).Value
too(i) = .Cells(i, 2).Value
Next i
End With
Note 1: the periods before the three Cells. Cells operates on the active worksheet. .Cells operates on the worksheet specified in the With statement.
Note 2: I have not placed a period before Rows.Count. Rows.Count returns the number of rows in the active worksheet. .Rows.Count returns the number of rows in the specified worksheet. The number of rows depends on the version of Excel and does not vary from worksheet to worksheet so most programmers do not bother with the period.
I would have made the two Worksheets parameters:
Sub xLator2(s1 As Worksheet, s2 As Worksheet)
This makes the subroutine much more flexible. I would probably go further and make the parameters Ranges which would give even more flexibility.
I could continue but I believe that is enough to start with. Good luck and welcome to the joys of programming.
Edit: Tutorial and complete solution
Part 1 - One reason not use Activate
Please study the following blocks of code which show why only the most junior VBA programmers use Activate without a very good reason. I do not want you to get too uptight about saving a few seconds or milliseconds. There are programmers who will spend half-an-hour to optimise a routine that is only run now and again. Only if a routine is to be run hundreds of times a day can that time be justified. I want you to appreciate that Application.ScreenUpdating = False can save a lot of time so you use it automatically. When Application.ScreenUpdating = False is included, the difference between Activate and With is a lot less but enough to justify making With the default choice.
For Count = 1 To 10000 ' This takes 148 seconds
Worksheets("Sheet1").Activate
Worksheets("Sheet2").Activate
Next
Application.ScreenUpdating = False ' This takes 11 seconds
For Count = 1 To 10000
Worksheets("Sheet1").Activate
Worksheets("Sheet2").Activate
Next
Application.ScreenUpdating = False ' This takes .07 seconds
For Count = 1 To 10000
With Worksheets("Sheet1")
End With
With Worksheets("Sheet2")
End With
Next
Application.ScreenUpdating = False ' This takes 12 seconds
For Count = 1 To 10000
Worksheets("Sheet1").Activate
Cells(23, 1).Value = "A"
Worksheets("Sheet2").Activate
Cells(23, 1).Value = "A"
Next
Application.ScreenUpdating = False ' This takes 1.16 seconds
For Count = 1 To 10000
With Worksheets("Sheet1")
.Cells(23, 1).Value = "A"
End With
With Worksheets("Sheet2")
.Cells(23, 1).Value = "A"
End With
Next
Application.ScreenUpdating = False ' This takes 0.96 seconds
Set Wsht1 = Worksheets("Sheet1")
Set Wsht2 = Worksheets("Sheet2")
For Count = 1 To 10000
With Wsht1
.Cells(23, 1).Value = "A"
End With
With Wsht2
.Cells(23, 1).Value = "A"
End With
Next
Part 2 - Copying values from a worksheet to an array
Macro LoadFromTo1() is based on the opening code of your macro which loads the From and Too tables. It is slightly different because my test data is slightly different. It takes six-tenths of a seconds to load the From and Too table
Sub LoadFromTo1()
' Takes about .594 seconds for 50,000 rows * 2 columns
Dim s1 As Worksheet
Dim N As Long, i As Long
Dim From(), too()
Dim InxFromTo As Long
Dim TimeStart As Single
TimeStart = Timer
Set s1 = Sheets("Test1") ' contains the data
s1.Activate
N = Cells(Rows.Count, 3).End(xlUp).Row
ReDim From(1 To N - 1)
ReDim too(1 To N - 1)
For i = 2 To N
From(i - 1) = Cells(i, 3).Value
too(i - 1) = Cells(i, 4).Value
Next i
Debug.Print "M1: " & Timer - TimeStart
For InxFromTo = 1 To 20
Debug.Print Right(" " & InxFromTo, 5) & " " & From(InxFromTo) & " " & too(InxFromTo)
Next
For InxFromTo = UBound(From) - 20 To UBound(From)
Debug.Print Right(" " & InxFromTo, 5) & " " & From(InxFromTo) & " " & too(InxFromTo)
Next
End Sub
Macro LoadFromTo2() (not shown) used With instead of Activate. With only only one Activate or With there was no noticiable change in performance.
Macro LoadFromTo3() uses a different technique for loading the tables. Insteading of importing the cell values one at a time, it imports then in a single statement: CellValue = .Range(.Cells(2, 3), .Cells(RowMax, 4)).Value. This statement will probably seems strange to you now. However, if you study and practice the technique, it will become second nature. I find LoadFromTo3() easier to code and understand than LoadFromTo1() and it is ten times as fast. I have read that importing a range as a unit rather than cell by cell can be fifty times faster although I have never achieved that level of performance improvement.
Sub LoadFromTo3()
' Takes about .0625 seconds for 50,000 rows * 2 columns
Const ColFrom As Long = 1
Const ColTo As Long = 2
Dim s1 As Worksheet
Dim RowMax As Long, RowCrnt As Long
Dim InxFromTo As Long
Dim TimeStart As Single
Dim CellValue As Variant
TimeStart = Timer
Set s1 = Sheets("Test1") ' contains the data
With s1
RowMax = .Cells(Rows.Count, 3).End(xlUp).Row
CellValue = .Range(.Cells(2, 3), .Cells(RowMax, 4)).Value
Debug.Print "M3: " & Timer - TimeStart
End With
For InxFromTo = 1 To 20
Debug.Print Right(" " & InxFromTo, 5) & " " & CellValue(InxFromTo, ColFrom) & _
" " & CellValue(InxFromTo, ColTo)
Next
For InxFromTo = UBound(CellValue, 1) - 20 To UBound(CellValue, 1)
Debug.Print Right(" " & InxFromTo, 5) & " " & CellValue(InxFromTo, ColFrom) & _
" " & CellValue(InxFromTo, ColTo)
Next
End Sub
Part 3 - Analysis of original code
First some definitions. The Target range is the column of words to be translated. The Target table is the the Target range loaded into memory. The FromTo Range is the From and To columns. The FromTo table is the the FromTo range loaded into memory.
This section has taken longer than I originally planned. Initially I only intended to conduct a proper test of my code. With the error in the code provided in an earlier answer and the implication there was another error, I was especially careful. I coded a routine that generated test data of varying sizes. I used that routine to generate the 50,000 row FromTo table I used for the timings in Part 2. I made some minor changes to the translate routine you published and ran it against my test data to give the following durations:
FromTo Target Target Duration
Rows Rows Cols in secs
50,000 20 1 103
50,000 10,000 1 486
10,000 3,000 2 60
The key section of my modified code was:
With RngTgt
For RowFromTo = 1 To UBound(FromToTable, 1)
.Replace What:=FromToTable(RowFromTo, ColFrom), _
Replacement:="__" + Str(RowFromTo), _
LookAt:=xlWhole
Next
For RowFromTo = 1 To UBound(FromToTable, 1)
.Replace What:="__" + Str(RowFromTo), _
Replacement:=FromToTable(RowFromTo, ColTo), _
LookAt:=xlWhole
Next
End With
I use a range so the Target range can be in any worksheet and be multi-column. I did not see the point of having such a large prefix and suffix which must result in a time penalty so I reduced to a prefix of two underscores. I include the LookAt:=xlWhole correction. I use a ToFrom table loaded from range. I have replaced i by the meaningful name RowFromTo to make the code more understandable.
There are no comments saying what this code does and why it does it this way. It is essential to include adequate comments in a macro. Will you remember what this macro does in six or twelve months? What if a colleague needs to amend it?
In your first FromTo table, "for" translates to "on" and "on" translates" to "upon". Without the two pass solution. "for" might be translated to "upon". This is my guess and it seems reasonable but there should have been a comment so I did not need to guess. A new programmer taking responsibility for this macro might be unable to guess and might "improve" the code by removing the "unnecessary" second pass.
The code behind the Replace method will be as efficient as its authors can manage but it will still have to examine every cell in the range. I have improved the situation by searching a specified range rather than the whole worksheet. However, it still has to search that range twice for every row in the FromTo table.
Studying this code I saw an immediate improvement. The first pass replaces the words in the Target table with "__1", "__2", "__n" and so on where 1, 2 and n are indices into the FromTo table. The second pass searches for "__1", "__2" and "__n". A better technique is to extract the 1, 2 and n and use them to access the correct entry in the FromTo table. With this better technique the duration were:
First Second
FromTo Target Target duration duration
Rows Rows Cols in secs in secs
50,000 20 1 103 52
50,000 10,000 1 486 257
10,000 3,000 2 60 32
That is, I halved the duration by changing the code to:
With RngTgt
For RowFromTo = 1 To UBound(ToFromTable, 1)
.Replace What:=ToFromTable(RowFromTo, ColFrom), _
Replacement:="__" + Str(RowFromTo), _
LookAt:=xlWhole
Next
End With
For Each Cell In RngTgt
Test = Mid(Cell.Value, 3)
If IsNumeric(Test) Then
Cell.Value = ToFromTable(Val(Test), ColTo)
End If
Next
However, I believed the basic approach to be wrong. If there are FT entries in the FromTo range and T entries in the Target range then:
With approach 1 there are 2 * FT replaces that require the searching of T cells.
With approach 2 there are FT replaces that require the searching of T cells and then T replaces.
Since the same word may repeat within the Target range, the search of the Target range must examine every cell. But what if we searched the From column of the FromTo rangw for each entry in the Target range? Unless there are a large number of words in the Target range that are missing from the FromTo range, an average FT / 2 entries will be examined before a match is found. Also there is no need for a second pass. We would expect a third approach based on this logical, to half the approach 2 durations.
I recoded the main part of my routine and repeated the tests
First Second Third
FromTo Target Target duration duration duration
Rows Rows Cols in secs in secs in secs
50,000 20 1 103 52 .13
50,000 10,000 1 486 257 61.51
10,000 3,000 2 60 32 7.54
This as a much bigger reduction in duration than I was expecting. I have some guesses as to the reason but I have not investigated further. I believe the final durations are acceptable. I have one further idea but I do not think it is worth the time to imvestigate.
The major lesson of the above is: think about your implementation startegy before implementing it. To me technique 3 is obviously superior to techniques 1 and 2 and I would have started with that technique. Some time spent on initial design can repay itself hansomely.
Part 4 - Final solution
You posted two workbooks each with the Target range in Sheet1 and the FromTo range in Sheet2. I created one workbook with the data from the second workbook copied to Sheet3 and Sheet3.
I amended your macro to call my macro:
Option Explicit
Sub xLator2()
Dim RngTgt As Range
Dim RngFromTo As Range
Dim RowMax As Long
Dim TimeStart As Single
With Worksheets("Sheet1")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngTgt = .Range(.Cells(1, "A"), .Cells(RowMax, "A"))
End With
With Worksheets("Sheet2")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngFromTo = .Range(.Cells(1, "A"), .Cells(RowMax, "B"))
End With
TimeStart = Timer
Call Translate3(RngTgt, RngFromTo)
Debug.Print "Sheet1 technique 3 duration: " & Timer - TimeStart
With Worksheets("Sheet3")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngTgt = .Range(.Cells(1, "A"), .Cells(RowMax, "A"))
End With
With Worksheets("Sheet4")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngFromTo = .Range(.Cells(1, "A"), .Cells(RowMax, "B"))
End With
TimeStart = Timer
Call Translate3(RngTgt, RngFromTo)
Debug.Print "Sheet3 technique 3 duration: " & Timer - TimeStart
End Sub
My macro for technique 3 takes two ranges as its parameters so there can be multiple Target and FromTo ranges which can be placed where ever convenient:
Sub Translate3(ByVal RngTgt As Range, ByVal RngFromTo As Range)
' RngTgt A rectangle containing words to be translated
' RngFromTo Two columns with the left column containing the original values
' for words and the right column containing the values to replace
' the original values.
' Constants numbering the From and To columns within RngFromTo. This makes the
' code easier to understand than if 1 and 2 had been used.
Const ColFrom As Long = 1
Const ColTo As Long = 2
Dim ColTgtCrnt As Long
Dim Test As String
Dim RngFindStart As Range
Dim RngFrom As Range
Dim RngTemp As Range
Dim RowFromTo As Long
Dim RowTgtCrnt As Long
Dim TgtTable As Variant
' Check FromTo range has two columns
If RngFromTo.Columns.Count <> 2 Then
Call MsgBox("ToFrom table must have two columns", vbOKOnly)
Exit Sub
End If
' Load Target range to array
TgtTable = RngTgt.Value
' Set RngFrom to the From column of RngFromTo
Set RngFrom = RngFromTo.Columns(ColFrom)
' Set RngFindStart to first cell of RngFrom
Set RngFindStart = RngFrom.Rows(1)
' Loop for every entry in Target table
For RowTgtCrnt = 1 To UBound(TgtTable, 1)
For ColTgtCrnt = 1 To UBound(TgtTable, 2)
Set RngTemp = RngFrom.Find(What:=TgtTable(RowTgtCrnt, ColTgtCrnt), _
After:=RngFindStart, _
LookAt:=xlWhole)
If Not RngTemp Is Nothing Then
' This target cell is to be translated
' Replace value in Target table with value for To column of FromTo table
TgtTable(RowTgtCrnt, ColTgtCrnt) = RngTemp.Offset(0, ColTo - ColFrom).Value
End If
Next
Next
' Upload updated array back to Target range
RngTgt.Value = TgtTable
End Sub
There is a lot to study here. Take it slowly and look up any statement you do not understand. Come back with questions if necessary but the more you understand on your own, the faster you will develop.