Thread: [Solved] Find and replace issue
View Single Post
 
Old 01-28-2020, 11:30 PM
djced djced is offline Windows XP Office 2007
Novice
 
Join Date: Jan 2020
Posts: 5
djced is on a distinguished road
Question Find and replace issue

Hi Dear Experts

Few letters are different in other fonts
So, I've problems in changing to new fonts
I use the following code (copied from internet) to solve this. Case specific.

Code:
Private Sub Test1()
         
  Dim strFindText As String
  Dim strReplaceText As String
  Dim nSplitItem As Long
   
  Application.ScreenUpdating = False

  ' Enter items to be replaces and new ones.
  strFindText = InputBox("Enter items to be found here,seperated by comma: ", "Items to be found") 
 'b,n,N,O,G,&,+,`,o,A,T,%,[,+,g{ - Find texts
  strReplaceText = InputBox("Enter new items here, seperated by comma: ", "New items")
  'o,b,n,G,g[,U:,g{,+,H,a[,t[,K:,$,G:,* - Replace texts
 
  nSplitItem = UBound(Split(strFindText, ","))

  ' Find each item and replace it with new one respectively.
  For nSplitItem = 0 To nSplitItem
    With Selection
      .HomeKey Unit:=wdStory
      With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Split(b, n, G, o, a, T, ",")(nSplitItem)
        .Replacement.Text = Split(o, b, n, G, H, ",")(nSplitItem)
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
      End With
    Selection.Find.Execute Replace:=wdReplaceAll
  End With
Next nSplitItem

  Application.ScreenUpdating = True

End Sub

1. I wish to remove input box and use permanent text string in place of that. But some are special characters like (, ), [, ], +, *, {, }
2. If the same is restricted to particular font (say 'xxx') and to particular selection
3. also note that few letters are interchanging like b,o,n etc (so it need to be changed to someother letter before final change

Thanking you!
Jai
Reply With Quote