Thread: [Solved] Find & Replace Unique word
View Single Post
 
Old 05-17-2017, 11:12 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,343
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]