Microsoft Office Forums - View Single Post - [Solved] replace data from variable with "sub and super script" from excel to word by vba

macropod · 06-22-2012, 02:31 AM

Quote:

Originally Posted by krishnaoptif

Now my logic has been chaged... if any text replaced is one time in document then will be red and if more then one time then that will be yellow for all

In that case, you could swap 'wdYellow' and 'wdRed' and change 'If iCount > 1 Then' to 'If iCount = 1 Then'

Quote:

there is some format issue in your code in my ms word line three text "probability of deletion (Pd)"

The simplest way to deal with with is to take a completely different approach. Try:

Code:

Application.ScreenUpdating = False
Dim lRow As Long, lTbl As Long
Dim RngFnd As Range, RngRep As Range, RngSrch As Range
Dim StrFnd As String, StrRep As String, StrSrch As String
With SrcWb
  SrcWs.UsedRange.Copy
  .Close False
End With
DoEvents
Set SrcWs = Nothing: Set SrcWb = Nothing
With ThisDocument
  .Range.InsertAfter vbCr
  .Characters.Last.Paste
  DoEvents
  lTbl = .Tables.Count
  Set RngSrch = .Range(0, .Tables(lTbl).Range.Start)
  For lRow = 2 To .Tables(lTbl).Rows.Count
    Set RngFnd = .Tables(lTbl).Rows(lRow).Cells(1).Range
    RngFnd.End = RngFnd.End - 1
    StrFnd = Trim(RngFnd.Text)
    Set RngRep = .Tables(lTbl).Rows(lRow).Cells(2).Range
    RngRep.End = RngRep.End - 1
    RngRep.Copy
    StrRep = Trim(RngRep.Text)
    Application.Options.DefaultHighlightColorIndex = wdRed
    With RngSrch.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .MatchCase = False
      .MatchWholeWord = True
      .Wrap = wdFindContinue
      .Text = StrFnd & "^w(" & StrRep & ")"
      .Replacement.Text = StrFnd
      .Execute Replace:=wdReplaceAll
      .Text = StrFnd
      .Replacement.Text = "^c"
      .Replacement.Highlight = True
      .Execute Replace:=wdReplaceAll
    End With
    StrSrch = RngSrch.Text
    If (Len(StrSrch) - Len(Replace(StrSrch, StrRep, ""))) / Len(StrRep) = 1 Then
      Application.Options.DefaultHighlightColorIndex = wdYellow
      With RngSrch.Find
        .Text = StrRep
        .Replacement.Text = "^&"
        .Highlight = True
        .Replacement.Highlight = True
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceOne
      End With
    End If
  Next
  .Tables(lTbl).Delete
  .Characters.Last.Delete
End With
Set RngSrch = Nothing: Set RngFnd = Nothing: Set RngRep = Nothing
Application.ScreenUpdating = True
MsgBox "Done"