Find and replace

D

DanielS

Board Regular
Joined
Sep 4, 2011
Messages
53
I have a list of what to find in column A (in all maximum 25 entries) and corresponding replacement entries in column B. I wish to search all the files in a folder but I do not want to search the entire range in the workbook but only look in column B in every workbook. When first entry is found, insert a new adjacent column i.e. column C and paste the replacement word there and then go on with all the other entries in the list. Can I have a macro for a task like this?. Thank you very much.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Make a backup of your folder first then try this. There's a couple of bits that need to be changed to suit your situation they are commented for you. HTH
Code: 
[COLOR="Navy"]Sub[/COLOR] test()
    [COLOR="Navy"]Dim[/COLOR] myDir [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR], fn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] searchTerms(), a()
    [COLOR="Navy"]Dim[/COLOR] r [COLOR="Navy"]As[/COLOR] Range
    [COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
    [COLOR="Navy"]Dim[/COLOR] sh [COLOR="Navy"]As[/COLOR] Worksheet
    [COLOR="Navy"]Dim[/COLOR] found [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
    
    myDir = "C:\Test\" [COLOR=Green]'<--Your folder path would go here[/COLOR]
    
    [COLOR=Green]'Change YOUR SHEET to the name of the sheet where th search terms are stored[/COLOR]
    [COLOR="Navy"]With[/COLOR] Sheets("YOUR SHEET") [COLOR=Green]'<--Change this![/COLOR]
        searchTerms = .Range("A1", .Cells(.Rows.Count, 1).[COLOR="Navy"]End[/COLOR](xlUp)(1, 2)).Value
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
    [COLOR="Navy"]With[/COLOR] CreateObject("Scripting.Dictionary")
        [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] UBound(searchTerms)
            .Item(searchTerms(i, 1)) = searchTerms(i, 2)
        [COLOR="Navy"]Next[/COLOR] i
        fn = Dir$(myDir & "*.xls*")
        [COLOR="Navy"]With[/COLOR] Application
            .ScreenUpdating = [COLOR="Navy"]False[/COLOR]
            .EnableEvents = [COLOR="Navy"]False[/COLOR]
            .DisplayAlerts = [COLOR="Navy"]False[/COLOR]
            .Calculation = xlCalculationManual
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
        [COLOR="Navy"]While[/COLOR] fn <> ""
            [COLOR="Navy"]If[/COLOR] fn <> ThisWorkbook.Name [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] wb = Workbooks.Open(myDir & fn)
                [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] wb.[COLOR="Navy"]ReadOnly[/COLOR] [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sh [COLOR="Navy"]In[/COLOR] wb.Sheets
                        Columns(3).Insert
                        [COLOR="Navy"]Set[/COLOR] r = sh.Range("B1", sh.Cells(sh.Rows.Count, 2).[COLOR="Navy"]End[/COLOR](xlUp)(1, 2))
                        a = r.Value
                        [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] UBound(a)
                            [COLOR="Navy"]If[/COLOR] .exists(a(i, 1)) [COLOR="Navy"]Then[/COLOR]
                                [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] found [COLOR="Navy"]Then[/COLOR] found = [COLOR="Navy"]True[/COLOR]
                                a(i, 2) = .Item(a(i, 1))
                            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                        [COLOR="Navy"]Next[/COLOR] i
                        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] found [COLOR="Navy"]Then[/COLOR]
                            sh.Columns(3).Delete
                        [COLOR="Navy"]Else[/COLOR]
                            r.Value = a
                            found = [COLOR="Navy"]False[/COLOR]
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                        [COLOR="Navy"]Set[/COLOR] r = [COLOR="Navy"]Nothing[/COLOR]
                    [COLOR="Navy"]Next[/COLOR] sh
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                wb.Close ([COLOR="Navy"]Not[/COLOR] wb.[COLOR="Navy"]ReadOnly[/COLOR])
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            fn = Dir$()
        [COLOR="Navy"]Wend[/COLOR]
        [COLOR="Navy"]With[/COLOR] Application
            .ScreenUpdating = [COLOR="Navy"]True[/COLOR]
            .EnableEvents = [COLOR="Navy"]True[/COLOR]
            .DisplayAlerts = [COLOR="Navy"]True[/COLOR]
            .Calculation = xlCalculationAutomatic
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Last edited:
Upvote 0
Just noticed a mistake.
Use this instead:
Code: 
[COLOR="Navy"]Sub[/COLOR] test()
    [COLOR="Navy"]Dim[/COLOR] myDir [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR], fn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] searchTerms(), a()
    [COLOR="Navy"]Dim[/COLOR] r [COLOR="Navy"]As[/COLOR] Range
    [COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    [COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
    [COLOR="Navy"]Dim[/COLOR] sh [COLOR="Navy"]As[/COLOR] Worksheet
    [COLOR="Navy"]Dim[/COLOR] found [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
    
    myDir = "C:\Test\" [COLOR=Green]'<--Your folder path would go here[/COLOR]
    
    [COLOR=Green]'Change YOUR SHEET to the name of the sheet where the search terms are stored[/COLOR]
    [COLOR="Navy"]With[/COLOR] Sheets("YOUR SHEET") [COLOR=Green]'<--Change this![/COLOR]
        searchTerms = .Range("A1", .Cells(.Rows.Count, 1).[COLOR="Navy"]End[/COLOR](xlUp)(1, 2)).Value
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
    [COLOR="Navy"]With[/COLOR] CreateObject("Scripting.Dictionary")
        [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] UBound(searchTerms)
            .Item(searchTerms(i, 1)) = searchTerms(i, 2)
        [COLOR="Navy"]Next[/COLOR] i
        fn = Dir$(myDir & "*.xls*")
        [COLOR="Navy"]With[/COLOR] Application
            .ScreenUpdating = [COLOR="Navy"]False[/COLOR]
            .EnableEvents = [COLOR="Navy"]False[/COLOR]
            .DisplayAlerts = [COLOR="Navy"]False[/COLOR]
            .Calculation = xlCalculationManual
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
        [COLOR="Navy"]While[/COLOR] fn <> ""
            [COLOR="Navy"]If[/COLOR] fn <> ThisWorkbook.Name [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] wb = Workbooks.Open(myDir & fn)
                [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] wb.[COLOR="Navy"]ReadOnly[/COLOR] [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sh [COLOR="Navy"]In[/COLOR] wb.Sheets
                        sh.Columns(3).Insert
                        [COLOR="Navy"]Set[/COLOR] r = sh.Range("B1", sh.Cells(sh.Rows.Count, 2).[COLOR="Navy"]End[/COLOR](xlUp)(1, 2))
                        a = r.Value
                        [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] UBound(a)
                            [COLOR="Navy"]If[/COLOR] .exists(a(i, 1)) [COLOR="Navy"]Then[/COLOR]
                                [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] found [COLOR="Navy"]Then[/COLOR] found = [COLOR="Navy"]True[/COLOR]
                                a(i, 2) = .Item(a(i, 1))
                            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                        [COLOR="Navy"]Next[/COLOR] i
                        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] found [COLOR="Navy"]Then[/COLOR]
                            sh.Columns(3).Delete
                        [COLOR="Navy"]Else[/COLOR]
                            r.Value = a
                            found = [COLOR="Navy"]False[/COLOR]
                        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                        [COLOR="Navy"]Set[/COLOR] r = [COLOR="Navy"]Nothing[/COLOR]
                    [COLOR="Navy"]Next[/COLOR] sh
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                wb.Close ([COLOR="Navy"]Not[/COLOR] wb.[COLOR="Navy"]ReadOnly[/COLOR])
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            fn = Dir$()
        [COLOR="Navy"]Wend[/COLOR]
        [COLOR="Navy"]With[/COLOR] Application
            .ScreenUpdating = [COLOR="Navy"]True[/COLOR]
            .EnableEvents = [COLOR="Navy"]True[/COLOR]
            .DisplayAlerts = [COLOR="Navy"]True[/COLOR]
            .Calculation = xlCalculationAutomatic
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Last edited:
Upvote 0
Thanks trunten for your quick reply. I just tried your first code (before the second was posted) and it seemed to work fine without any problem. I will try the second one also and come back with a feedback.

Thanks once again!
 
Upvote 0
Hi trunten:

I tried the second code and it is also working fine.

Regarding the first code, well, even that code is also inserting a column rather than overwriting. I ran the first code again to confirm this. In fact, overwriting would be a better option for me because sooner or later, I was going to delete that original column. Please check up again.

Thanks.
 
Upvote 0
DanielS said:
Hi trunten:

I tried the second code and it is also working fine.

Regarding the first code, well, even that code is also inserting a column rather than overwriting. I ran the first code again to confirm this. In fact, overwriting would be a better option for me because sooner or later, I was going to delete that original column. Please check up again.

Thanks.
Click to expand...

:) If it works it works I guess.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Macro to correct entries across multiple sheets
Replies
1
Views
108
Lux Aeterna
L
T
  • Solved
Replace Word in Cell with Value from Another Cell
2
Replies
10
Views
583
Akuini
Akuini
D
  • Question Question
VBA Code Copy/Replace Values base on Date
Replies
1
Views
107
Anthony47
A
M
  • Question Question
Match cell contents exactly for find and replace based on a table
Replies
3
Views
727
mumps
mumps
T
  • Question Question
Formula / Script to do Find and Replace for Multiple Groups of 10 rows replacing with different words / phrase each time
Replies
5
Views
217
hagia_sofia
hagia_sofia

Forum statistics

Threads
1,223,275
Messages
6,171,127
Members
452,381
Latest member
Nova88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top