mulitple search and replace criteria

[mdhingra]

I am asking this question for my uncle. He has a very large document he wrote. Some changes are necessary to this document and he is aware of using a search and replace to make those changes. He has maybe 5000 -6000 criteria to search and replaces on. Each crieteria is a sequence of charatcters,not just one character. Is there a tool that allows you to search on more than 1 string of text and replace with more than one string of text.

The other option I was thinking might work would be using a DB to enter the serach criteria in column 1 and the replace criteria in column 2. I don' t know how to link the DB to the Word doc to perform the search (if this is possible), or to bring the doc into the DB and perform to update on it there. It is also important to maintain the document formatting.

Thanks for any ideas or help.

[macropod]

hi mdhingra,

Welcome to the forum.

The following macro allows you to use an Excel workbook to hold Find/Replace strings as the source for a large-scale Find/Replace operation. The macro looks for a workbook named 'Workbook Name.xls', finds the strings in the document referred to in column A on Sheet1 and replaces them with the strings referred to in column B. The user has the option to skip particular found strings, or to cancel the process altogether. Comments in the code show how to make the processing automatic (ie no user intervention). The bulk of the code (around 80%) is for managing the Excel session. You will need to change the 'StrWkBkNm' and 'StrWkSht' variables to match the workbook you use.

Sub BulkFindReplace()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Workbook Name.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    ' Add 1 to get the next row for data-entry.
    iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
    ' Output the captured data.
    For i = 1 To iDataRow
      ' Skip over empty fields to preserve the underlying cell contents.
      If Trim(.Range("A" & i)) <> vbNullString Then
        xlFList = xlFList & "|" & Trim(.Range("A" & i))
        xlRList = xlRList & "|" & Trim(.Range("B" & i))
      End If
    Next
  End With
  If bFound = False Then xlWkBk.Close False
  If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFList, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = True
      .Wrap = wdFindStop
      .Text = Split(xlFList, "|")(i)
      .Execute
       'To automatically change the found text:
       '• comment-out/delete the previous line and the Do While Loop
       '• uncomment the next two lines
      ‘.Replacement.Text = Split(xlRList, "|")(i)
      ‘.Execute Replace:=wdReplaceAll
    End With
    'Ask the user whether to change the found text
    Do While .Find.Found
      .Duplicate.Select
      Rslt = MsgBox("Replace this instance of:" & vbCr & _
        Split(xlFList, "|")(i) & vbCr & "with:" & vbCr & _
        Split(xlRList, "|")(i), vbYesNoCancel)
      If Rslt = vbCancel Then Exit Sub
      If Rslt = vbYes Then .Text = Split(xlRList, "|")(i)
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub

Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

[RetiredGeek]

Paul,

Thanks for that great hunk of code! It's going into my toolbox of very useful code.

[mdhingra]

Paul:

Thanks for the quick reply and the thorough explanation. I will be trying the code in the next day or two and will let you know how it worked. Thanks again for your help.

Muneesh