Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    May 2012
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    mulitple search and replace criteria

    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.

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,979
    Thanks
    0
    Thanked 208 Times in 189 Posts
    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.
    Code:
    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
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. The Following User Says Thank You to macropod For This Useful Post:

    RetiredGeek (2012-05-09)

  4. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,494
    Thanks
    212
    Thanked 852 Times in 784 Posts
    Paul,

    Thanks for that great hunk of code! It's going into my toolbox of very useful code.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  5. #4
    New Lounger
    Join Date
    May 2012
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Smile Thanks

    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •