Find and Replace Values in all excel files of Directory

[shreeram.maroo]

Hi,
I have bunch of excel files in a directory and sub directory. I want to find and replace values in all files of particular directory and its Subdirectories.

I have the following VBA code, taken from microsoft website, but it works only for one Specific directory :

Code: Select all

Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Can u please tell me how to replace in subfolders also ?
Thanks in advance

Shreeram Maroo

[HansV]

Welcome to Eileen's Lounge!

If nobody else replies, I'll work on it in a few hours' time.

[shreeram.maroo]

Sure..

Thanks...

[Rudi]

Welcome from me too...

I happened to have similar code available from a previous project.
Note, you need to activate a reference to the Microsoft Scripting Runtime Library in the Tools > References menu of VBE.
I also include the sample workbook...

Replace In root folder and all first level subfolders (only 1 level deep)

Code: Select all

Sub ReplaceInFolder()
Dim fso As Scripting.FileSystemObject
Dim Folder As Scripting.Folder, SubFolder As Scripting.Folder, File As Scripting.File
Dim strPath As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strFind As String
Dim strReplace As String

    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    If strFind = "" Then
        MsgBox "No replace text specified!", vbExclamation
        Exit Sub
    End If
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    Set fso = New Scripting.FileSystemObject
    Set Folder = fso.GetFolder(strPath)
    Application.ScreenUpdating = False
    For Each File In Folder.Files
        Set wbk = Workbooks.Open(File)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                              LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
    Next
    For Each SubFolder In Folder.SubFolders
        For Each File In SubFolder.Files
            Set wbk = Workbooks.Open(File)
            For Each wsh In wbk.Worksheets
                wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                                  LookAt:=xlWhole, MatchCase:=False
            Next wsh
            wbk.Close SaveChanges:=True
        Next
    Next
    Application.ScreenUpdating = True
    MsgBox "All Excel Files processed", vbInformation
End Sub

Replace in root folder and all subfolders (all levels deep)

Code: Select all

Sub ReplaceInAllSubFolders()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim myFolder As Object
Dim strPath As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strFind As String
Dim strReplace As String
  
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    If strFind = "" Then
        MsgBox "No replace text specified!", vbExclamation
        Exit Sub
    End If
    Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With myFolder
        .Title = "Select root folder to process..."
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        strPath = .SelectedItems(1) & "\"
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(strPath)
    Application.ScreenUpdating = False
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'de-queue
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder 'en-queue
        Next oSubfolder
        For Each oFile In oFolder.Files
            Set wbk = Workbooks.Open(oFile)
            For Each wsh In wbk.Worksheets
                wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                                  LookAt:=xlWhole, MatchCase:=False
            Next wsh
            wbk.Close SaveChanges:=True
        Next oFile
    Loop
    Application.ScreenUpdating = True
    MsgBox "All Excel Files processed", vbInformation
End Sub

Test.xlsm

[shreeram.maroo]

Hi Rudi,

All levels deep macro working properly, but i also have some word files in between.
So when it reaches the first word file , it shows File format is not valid

[Rudi]

Hi,

Replace the appropriate part of code with this part...

Code: Select all

        For Each oFile In oFolder.Files
            If InStr(1, oFile.Name, ".xls") > 0 Then
                Set wbk = Workbooks.Open(oFile)
                For Each wsh In wbk.Worksheets
                    wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                                      LookAt:=xlWhole, MatchCase:=False
                Next wsh
                wbk.Close SaveChanges:=True
            End If
        Next oFile        

[shreeram.maroo]

Its Working !!!!!
Thanks a lot Rudi. You saved my lots of time.

[shreeram.maroo]

Hi Rudi,

Do you have the same macro for replacing in the word files of a folder and its subfolders

[Rudi]

Hi Rudi,

Do you have the same macro for replacing in the word files of a folder and its subfolders

This is untested, but should work in Word too.
Obviously place the code you need repeated inside the loops where the comments indicate...

Code: Select all

Sub LoopThroughFolders()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim myFolder As Object
Dim myPath As String
    
    Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With myFolder
        .Title = "Select top folder to process..."
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        myPath = .SelectedItems(1) & "\"
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(myPath)

    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            '...insert any folder processing code here...
            queue.Add oSubfolder 'en-queue
        Next oSubfolder
        For Each oFile In oFolder.Files
            '...insert any file processing code here...
        Next oFile
    Loop
    MsgBox "All folders processed!", vbInformation
End Sub

[shreeram.maroo]

Hi,
I am not getting what to do .
Can you please eloborate.
I want to find certain text in all word files of a folder and its subfolders and replace it .

[HansV]

Here you go. This code should be ran from Word.

Code: Select all

Sub LoopThroughFolders()
    Dim fso As Object, oFolder As Object, oSubfolder As Object, oFile As Object, queue As Collection
    Dim myFolder As Object
    Dim myPath As String

    Set myFolder = Application.FileDialog(4) ' msoFileDialogFolderPicker
    With myFolder
        .Title = "Select top folder to process..."
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        myPath = .SelectedItems(1) & "\"
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    queue.Add fso.GetFolder(myPath)

    Application.ScreenUpdating = False
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder 'en-queue
        Next oSubfolder
        For Each oFile In oFolder.Files
            ProcessFile oFile.Path
        Next oFile
    Loop
    Application.ScreenUpdating = True

    MsgBox "All folders processed!", vbInformation
End Sub

Sub ProcessFile(strFile As String)
    Dim doc As Document
    Set doc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False)
    With doc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "Text to find"
        .Replacement.Text = "Text to replace with"
        .MatchCase = False ' or True
        .MatchWholeWord = False ' or True
        .MatchWildcards = False
        .Execute Replace:=wdReplaceAll
    End With
    doc.Close SaveChanges:=True
End Sub

In the ProcessFile procedure, change the text in the lines

Code: Select all

        .Text = "Text to find"
        .Replacement.Text = "Text to replace with"

to suit your purpose.

[Doc.AElstein]

Hi,
I am not getting what to do ........

Hi shreeram.maroo,
I had started a reply as Hans did it all for you, so I will post it anyway, just as an alternative..
First, importantly, I think what Rudi was implying was along the line of what I was suggesting in my long post. That is to say that the main thing being done here is the “getting at” all Files and Sub Folders in a Main Folder. In Rudi’s code then you put what you actually want to be done to a File ( my “Doing Stuff” ) where he indicated

Code: Select all

             '...insert any file processing code here...

Correspondingly in any of my codes to

Code: Select all

            ''''''''Doing Stuff for Each File
    '       'Dim wkb As Workbook: Set wkb = Workbooks.Open(oFile) ' For Excel !   '                
    '       (...insert any file processing code here  )             
    '                
    '       'wkb.Close SaveChanges:=True ‚ For Excel !       
            ''''''''End Doing Stuff for Each File

_...................................

I know virtually nothing about Word VBA, but to have a go at the code for your “Doing” stuff. I…….
_1 ) Started running a macro recording.
_2) I Opened any spare document which had some “Poo” in it. ( Which is of course is best removed ! )
_3 ) Hit Ctrl A to select the whole Text
_4 ) Used the Find Replace Dialogue Box thing to replace any “Poo” with “xxx” for the whole document
_ 5) Closed the File
_6 ) Stopped running the recorder.

I got this code from doing all that:.

Code: Select all

Sub Makro6()
'
' Makro6 Makro
'
'
    Documents.Open FileName:="AFileWithSomePooIn.docx", ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
        DocumentDirection:=wdLeftToRight
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "poo"
        .Replacement.Text = "xxx"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.Close
End Sub

_...............................................

So I played around a bit taking bits out of that code, ( and occasionally putting them beck in if the code then did not then work!! )…… I also did a mod or two based on what I Learnt from the last answer in a similar Question I asked here……………
http://www.eileenslounge.com/viewtopic.php?f=26&t=22603" onclick="window.open(this.href);return false;
_~~~~~~….. and so eventually I simplified it to this shortened code version
Sub MakroModPodPooxxx()

Code: Select all

Sub MakroModPodPooxxx()
Documents.Open FileName:="AFileWithSomePooIn.docx"
    Selection.WholeStory 'Ctrl A
    With Selection.Find 'I think this sort of calls up a shortened default version of the Find Replace Dialogue Box
    .Text = "poo"
    .Replacement.Text = "xxx"
    .Execute Replace:=wdReplaceAll
    End With
    ActiveWindow.Close SaveChanges:=True 'SaveChanges:=True stops me being asked if I want to save Document
End Sub ' MakroModPodPooxxx() 

_.................................................

Hans code is a lot neater, ( in the main Routine his “Doing stuff” is just one line calling a second Routine, Sub ProcessFile ( ). In that second routine he wrote directly a more efficient code, - but which you will see his
Sub ProcessFile(strFile As String)
has some similarities to my
Sub MakroModPodPooxxx()
_........................................................

Hope that helps to explain it all a bit. ( Once you know the answer you see you were really asking for a Short Word VBA code. The rest was a straight forward application of the codes here to loop through all folders and sub Folders ). So your approach should be to get a short code working on one file such that it is doing the stuff you want. Then you stick it in at the approriate place in the main Code which "loops through all Files in all Folders and Sub Folders in a Main Folder"

Alan

P.s. So for completeness here is a full single Code doing what you want. ( But I recommend you hhave a go at writng one yourself. All the info you need is in this Thread ! )
Anyway, My start point was my version of Rudi’s Queue code. ( I like this as an alternative to the Recursion type codes most people use, as there is no need for an initial Routine to call the Recursion Routine ( Recursion being the idea of a Routine calling itself ) ).
- So the Queue code makes it a lot less bother with not having to pass over lots of needed variables in the ( Signature line ( ByVal this, ByVal that etc… ) ) of the called Routine and at the Call-ing line in the Main Routine. ) . Because of not having to pass over so many variables it is easy to stick the two Input Boxes like wot Rudi did originally. So I did. They ask you for the strings you want to Find and Replace. ( I have simply commented out ( '+ ) bits of my original code which are not relevant to the “stuff” you want to do )

Code: Sub ReplaceInAllSubFoldersQingWordMakroModPodPooxxx ()
' This code should be ran from Word.

Code: Select all

 Option Explicit
'  Rudi     http://www.eileenslounge.com/viewtopic.php?f=27&t=22499#p177221   Hans   http://www.eileenslounge.com/viewtopic.php?f=27&t=22499#p177241
'   This code should be ran from Word.
 Sub ReplaceInAllSubFoldersQingWordMakroModPodPooxxx()
'+    Rem 1Q) Some Worksheets and General Variables Info   '+ NOT RELEVANT FOR WORD WONK
'+    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets.Item(1) 'Worksheets("RudyMSRQueue") 'CHANGE TO SUIT YOUR WORKSHEET
'+    Dim strDefPath As String: Let strDefPath = ThisWorkbook.Path ' Any Path to Folder to test this code! here we simply use the Path where the File with this code in is
'+    Dim strDefFldr As String: Let strDefFldr = "EileensFldr" 'Just for an initial suggestion
Rem 1.5Q) Rudi Input Boxes
Dim strFind As String, strReplace As String
Let strFind = InputBox(prompt:="Enter text to find", Title:="Find", Default:="poo") '
    If strFind = "" Then
    MsgBox "No find text specified!", vbExclamation
    Exit Sub
    End If
Let strReplace = InputBox(prompt:="Enter replacement text", Title:="Replace", Default:="xxx")
    If strFind = "" Then
    MsgBox "No replace text specified!", vbExclamation
    Exit Sub
    End If

Rem 2Q) Get Folder Info ( Using VBA Application.FileDialog(msoFileDialogFolderPicker) Property )
Dim strWB As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Folder Select "
    .AllowMultiSelect = False
        If .Show <> -1 Then
        Exit Sub
        End If
    Let strWB = .SelectedItems(1) & "\"
  End With

Rem 3Q) Microsoft Scripting Runtime Library
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") 'Late Binding
'Dim FSO As Scripting.FileSystemObject 'Early Binding alternative  activate a reference to the Microsoft Scripting Runtime Library in the Tools > References menu of VBE.
'Set FSO = New Scripting.FileSystemObject

Rem 4Q)'Some variables for Positon of Things
'+    Dim rCnt As Long, clmLvl As Long: Let clmLvl = 1: Let rCnt = -1 'rowCount is genaraly increase for a new entry, Column "level" is intended to give an indication of how far down ( to he right ) you are in the Folder chain. Ste to 1 for the first mainn Initial Folder.
'+    Dim CurrentLvlCnt As Long: CurrentLvlCnt = 1 'Count of the Number of Folders in the Folder level currently being run through.
'+    Dim NxtLvlCnt As Long 'Count of the Number of Folders in the next level
Dim queue As Collection
Set queue = New Collection
queue.Add FSO.GetFolder(strWB) 'Main Folder Put at position 1 of Queue'''''
'+    Dim celTL As Range: Set celTL = ws.Range("A1") 'Top left of where Listing should go
'Application.ScreenUpdating = False

Rem 5Q) Main loop. Do While Queue is not Empty effectivelly goes through all Folders
Dim oFile As Object, oFolder As Object, oSubfolder As Object
'Dim oFile As File, oFolder As Folder, oSubfolder As Folder 'For Early Binding
    Do While queue.Count > 0 'Main Loop. Does as many times as there are things ( Folders here ) stacked in the Queue========
    Set oFolder = queue(1) 'Next Folder .... effectively
    queue.Remove 1 'de-queue'......"taken" from start of Queue. ( Actually it is assigned to a variable, then removed from the Queue, which probably just has the Pointer to it.
'+        CurrentLvlCnt = CurrentLvlCnt - 1 'de-the count for numbers in in this current Folder level
    ''''''''Doing Stuff For the Folder
'+        rCnt = rCnt + 2 'Move on a line and a spare Line for every Folder Entry
'+        celTL.Cells(rCnt, 1).Value = oFolder.Path: celTL.Cells(rCnt, clmLvl).Offset(0, 1).Value = oFolder.Name 'Cell poroperty of Top Left Cell Range Object uset to position output.
    ''''''''End Doing Stuff for each Folder
    '5Qa) Add any Sub Folders from current Folder at end of queue
        For Each oSubfolder In oFolder.SubFolders 'For as many ( if any ) Sub Folders In the Current Folder
        queue.Add oSubfolder 'en-queue.. add the Sub Folder on at the end of the Queue
'+            NxtLvlCnt = NxtLvlCnt + 1 'en-the count of the Folders in the next Level..Increase our count of the Folders in the Next folder level
        Next oSubfolder
        '5b) Doing Stuff for every file in current folder
            For Each oFile In oFolder.Files
            '''''''Doing Stuff for Each File here
            'Sub MakroModPodPooxxx()
            On Error GoTo ErrHdlr 'In case problem opening file for example
                'Set wbk = Workbooks.Open(oFile) ' For Excel
            Documents.Open FileName:=oFile.Path '"AFileWithSomePooIn.docx"
            Selection.WholeStory 'Ctrl A
            With Selection.Find 'I think this sort of calls up a shortened default version of the Find Replace Dialogue Box
            .Text = "" & strFind & ""
            .Replacement.Text = "" & strReplace & ""
            .Execute Replace:=wdReplaceAll
            End With
            ActiveWindow.Close SaveChanges:=True 'SaveChanges:=True stops me being asked if I want to save Document
            'End Sub ' MakroModPodPooxxx()
'+                    If InStr(1, oFile.Name, ".xls") > 0 Then 'Option to select only if .xls ( or .xlsx or .xlsm ) type files
'+                    rCnt = rCnt + 1
'+                    celTL.Cells(rCnt, clmLvl).Offset(0, 1).Value = oFile.Name

                'wbk.Close SaveChanges:=True ' For Excel
'+            Else: End If
            '''''''End Doing Stuff for Each File
NxtoFile:   Next oFile ' Spring Point after error handler so as to go on to next File after the File action that errored
'+            '5Qc) should we have reached the end of the current level of Folders, we reset the level Column for output, and make the new Current Folders in Folder level Count equel to the next one, as we go ion now to Folders from the next level.
'+            If CurrentLvlCnt = 0 Then
'+            clmLvl = clmLvl + 1 'Set column position 1 to the left "down" the Folder Level Chain.
'+            Let CurrentLvlCnt = NxtLvlCnt 'So the current Folder Level count of Folders becomes that last counted.
'+            NxtLvlCnt = 0 'Next level of Folders currently are not in the Queue. This will be re counted for the next Folders as Sub Folders are added to the back of the Queue
'+            Else
'+            End If
        
    Loop 'queue.Count > 0 main loop for all Folders=====================================================================
Application.ScreenUpdating = True
MsgBox "All Excel Files processed", vbInformation
'+    ws.Columns("A:H").AutoFit
Exit Sub 'Normal End for no Erriors
Rem 6) 'Error handler section just put here for convenience
ErrHdlr: 'Hopefully we know why we are here, and after informing can continue ( to next file )
MsgBox prompt:="Error " & Err.Description & " with File " & oFile.Path & ""
On Error GoTo -1 'This needs to be done to reset the VBA exceptional error state of being. Otherwise VBA "thinks"" Errors are being handeled and will not respond again to the Error handler.
On Error GoTo 0 ' Swiches off the current error handler. I do not really need to do this. But it is good practice so the error handler is only in place at the point where i next am expecting an error
GoTo NxtoFile
End Sub

[snb]

or ?

Code: Select all

Sub M_snb()
   With Application.FileDialog(4)
      If .Show Then
        sn = Split(CreateObject("wscript.shell").exec("cmd /c dir """ & .SelectedItems(1) & "*.doc"" /b/s/a-d").stdout.readall, vbCrLf)
        For j = 0 To UBound(sn) - 1
           With GetObject(sn(j))
              .Content = Replace(.Content, "text to be replaced", "replacement text")
              .Windows(1).Visible = True
              .Close -1
           End With
        Next
      End If
  End With
End Sub

[Doc.AElstein]

I will let you know when I have worked out HOW it works, Lol..
;)

[shreeram.maroo]

Hi Hans,

Does the code works for headers/ footers also ?
and can we make use of wild cards like * and ? for "Text to search"

[HansV]

If you change the line

Code: Select all

        .MatchWildcards = False

to

Code: Select all

        .MatchWildcards = True

you can use wildcard characters in the .Text argument. It's best to test the 'Find what' text interactively first, to make sure that it works as intended.

To replace text in headers and footers requires extra code. Replace the entire code for ProcessFile with the following:

Code: Select all

Sub ProcessFile(strFile As String)
    Dim doc As Document
    Dim rngStory As Word.Range
    Dim lngJunk As Long
    Dim oShp As Shape
    Set doc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False)
    'Fix the skipped blank Header/Footer problem
    lngJunk = doc.Sections(1).Headers(1).Range.StoryType
    'Iterate through all story types in the current document
    For Each rngStory In doc.StoryRanges
        'Iterate through all linked stories
        Do
            SearchAndReplaceInStory rngStory
            On Error Resume Next
            Select Case rngStory.StoryType
            Case 6, 7, 8, 9, 10, 11
                If rngStory.ShapeRange.Count > 0 Then
                    For Each oShp In rngStory.ShapeRange
                        If oShp.TextFrame.HasText Then
                            SearchAndReplaceInStory oShp.TextFrame.TextRange
                        End If
                    Next oShp
                End If
            Case Else
                'Do Nothing
            End Select
            On Error GoTo 0
            'Get next linked story (if any)
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next rngStory
    doc.Close SaveChanges:=True
End Sub

Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range)
    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "text to find"
        .Replacement.Text = "text to replace with"
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub

This code is based on Using a macro to replace text where ever it appears in a document.

[shreeram.maroo]

Thanks a lot Hans..