Find & Replace Unique word

macropod · #16 05-17-2017, 11:12 PM

Your Excel Find list contains characters that, when used for wildcards, are 'special' characters (e.g. (){}[]<>-@\!?*^). If you need to Find the literal characters, therefore, you need to prefix each of them a \, except for the ^ which must be replaced with ^094. That can all be done in your code via a simple string replacement loop without changing the Excel data. For example:

Code:

Sub RemoveShreeLipiDistortionUsingWildCards()
Application.ScreenUpdating = False
Dim objExcel As Object, Counter As Long, i As Long, j As Long
Dim StrFnd As String: StrRep As String: Const StrEsc As String = "(){}[]<>-@\!?*"
    
Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open(ActiveDocument.Path + "\List of ShreeLipi Distortion (1).xlsx")
With exWb.Worksheets(1)
  Counter = .Range("A" & .Cells.SpecialCells(11).Row).End(-4162).Row ' 11 = xlCellTypeLastCell, -4162 = xlUp

  For i = 2 To Counter
    StrFnd = Replace(.Range("A" & i), "^", "^^")
    StrRep = Replace(.Range("B" & i), "^", "^^")
    For j = 1 To Len(StrEsc)
      StrFnd = Replace(StrFnd, Mid(StrEsc, i, 1), "\" & Mid(StrEsc, i, 1))
    Next
    StrFnd = Replace(StrFnd, "^", "^094")
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .MatchWildcards = True
      .Wrap = wdFindContinue
      .Text = "<" & StrFnd & ">"
      .Replacement.Text = StrRep
      .Execute Replace:=wdReplaceAll
    End With
  Next i
  .Close False
End With
Set exWb = Nothing: Set objExcel = Nothing
Application.ScreenUpdating = True
End Sub

A non-wildcard equivalent would be:

Code:

Sub RemoveShreeLipiDistortionUsingWildCards()
Application.ScreenUpdating = False
Dim objExcel As Object, Counter As Long, i As Long, j As Long, StrFnd As String, StrRep As String
    
Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open(ActiveDocument.Path + "\List of ShreeLipi Distortion (1).xlsx")
With exWb.Worksheets(1)
  Counter = .Range("A" & .Cells.SpecialCells(11).Row).End(-4162).Row ' 11 = xlCellTypeLastCell, -4162 = xlUp

  For i = 2 To Counter
    StrFnd = Replace(.Range("A" & i), "^", "^^")
    StrRep = Replace(.Range("B" & i), "^", "^^")
    With ActiveDocument.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Wrap = wdFindContinue
      .Text = StrFnd
      .Replacement.Text = StrRep
      .Execute Replace:=wdReplaceAll
    End With
  Next i
  .Close False
End With
Set exWb = Nothing: Set objExcel = Nothing
Application.ScreenUpdating = True
End Sub

Still, given what your Excel data are, I can't see the need for wildcards. Neither can I see the purpose of your:
Replace(exWb.Worksheets(1).Range("A" & i), "^", "^^")
and:

Replace(exWb.Worksheets(1).Range("B" & i), "^", "^^")
If you need to use double-carets, why not include them in the Excel data?

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
MS Word 2016 Find and Replace	BillM	Word	2	03-14-2017 10:49 AM
Need help using Find & Replace (MS Word)	BZee	Word	9	02-16-2015 05:45 PM
Replace each heading with a unique numeric value	amitkapoor	Word	7	05-06-2013 03:29 AM
Word Find and Replace Query	bthart	Word	1	12-29-2011 12:45 AM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM