Need to know how to build a Macro in Word that will do this please... 1

[ewornibor]

A friend of mine is looking to build a Document search for Rescinded words. That's the easy part. (He can find and highlight words). What he would like it to do is Find the word and have it change the font to red and be stricken through, the add a word after it in Blue and underlined. (Rescinded word / New Word). And maybe add a yellow Highlight over them all in one search.

Using Word 2013.

Thanks Everyone.

 

[SkipVought]

Hi

Have you tried to record the steps in your macte recorder?

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[ewornibor]

I am not really sure what all would need to be selected if he did the record macro function. I have only worked w/ very simple macros in the past.

 

[macropod]

Other than the highlighting, you can set 'Track Changes' to do that by default. So, with just two Find/Replace operations, you can Find & highlight the words, turn 'Track Changes' on, then Find the words & Replace them with the alternate ones, before turning 'Track Changes' off again. You could, of course, record a macro to do that but, unless you have many words to process at once (in which case the macro recorder isn't going to cut it), a macro hardly seems worth the effort.

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

My friend said this: I have a laundry list of rescinded words and phrases that I have to search for. Was hoping to already have the associated replacement word there. We live in track changes here... That why I was asking for the format in macro.


SO, if the macro recorder isn't what is needed to do this, what does he need to do?

Thanks

 

[macropod]

It doesn't really matter that you have a 'laundry list', the process is essentially the same and could be automated with a macro. Do you have some objection to using 'Track Changes'?

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

He is using track changes, he wants to know how to create the macro to highlight the word that is being replaced and then also already have the word that SHOULD replace it right there, highlighted as well that way he doesn't have to refer to the list every time he needs to find/fix a phrase in a document... he has to update a bunch of old documentation and has to remove/replace rescinded terminology and that is the purpose of this. Track changes is being used, he wants to be able to run this macro so it will auto-cross out the rescinded words and put the new terminology right next to it, making editing easier.


I started playing around with it a little bit and it doesn't quite do what he's looking to do:
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.TypeText Text:="test replace"
Selection.MoveLeft Unit:=wdCharacter, Count:=9
Selection.TypeBackspace
Selection.MoveLeft Unit:=wdCharacter, Count:=5, Extend:=wdExtend
Selection.Font.StrikeThrough = wdToggle
Selection.MoveRight Unit:=wdCharacter, Count:=13
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=14, Extend:=wdExtend
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=8
Selection.MoveRight Unit:=wdCharacter, Count:=8
Selection.MoveLeft Unit:=wdCharacter, Count:=7, Extend:=wdExtend
End Sub

 

[macropod]

Try the following macro. As coded, it uses an Excel workbook named 'BulkFindReplace.xlsx' in the user's 'Documents' folder to hold the terms to find in column A and there replacements in column B. The macro uses a combination of Highlighting & 'Track Changes' for the processing.

Sub BulkTerminologyRescinder()
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, xlFList, xlRList, i As Long
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\BulkFindReplace.xlsx"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
On Error GoTo 0
With xlApp
  'Hide our Excel session
  .Visible = False
  Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
  If xlWkBk Is Nothing Then
    MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
    .Quit
    Exit Sub
  End If
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    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
  xlWkBk.Close False
  .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
' Process the data.
Application.ScreenUpdating = False
ActiveDocument.TrackRevisions = False
With Options
  .DefaultHighlightColorIndex = wdYellow
  .InsertedTextMark = wdInsertedTextMarkUnderline
  .InsertedTextColor = wdBlue
  .DeletedTextMark = wdDeletedTextMarkStrikeThrough
  .DeletedTextColor = wdRed
End With
' Apply Highlighting to Rescinded Terms
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)
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
'Replace the Rescinded Terms
ActiveDocument.TrackRevisions = True
For i = 1 To UBound(Split(xlFList, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .MatchCase = True
      .Wrap = wdFindContinue
      .Text = Split(xlFList, "|")(i)
      .Replacement.Text = Split(xlRList, "|")(i)
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
ActiveDocument.TrackRevisions = False
Application.ScreenUpdating = True
End Sub

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

WOW, thank you SO MUCH!!!!!!!! It does exactly as he wanted... you are awesome. (I tested it) He's out of the office for a couple of days so I will have him test it when he gets back and let you know if there are any issues, but I don't anticipate that there will be. THANK YOU AGAIN, SO MUCH!!!!!! You ROCK!!!

 

[macropod]

Cross-posted at:

https://social.msdn.microsoft.com/F...n-word-that-will-do-this-please?forum=worddev

For cross-posting etiquette, please read:

http://www.excelguru.ca/content.php?184

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

He wants to know if there's a way so that the "rescinded word" doesn't get deleted, just is highlighted like it is now, so he can decide whether it needs to be deleted or not before it actually shows up as deleted in track changes.

As he put it: "... I need the original word to stay not be replaced. I have to read the context and decide if it should be deleted. Can you have it do that?"

Thank you!

 

[Andrzejek]

(Almost) anything is possible

Your friend may benefit from stepping thru the code and see what's going on and where in the code 'stuff' happens. That is a great way to learn.

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[ewornibor]

Well unfortunately he doesn't have time to really learn this, he's trying to get this done for a job he has to complete, but thanks for the suggestion. He's not a programmer...

 

[ewornibor]

Still just need to know how to do this if it is possible please:
He wants to know if there's a way so that the "rescinded word" doesn't get deleted, just is highlighted like it is now, so he can decide whether it needs to be deleted or not before it actually shows up as deleted in track changes.

As he put it: "... I need the original word to stay not be replaced. I have to read the context and decide if it should be deleted. Can you have it do that?"

Thank you!

 

[macropod]

You asked for code to both highlight and replace the words, which is what I provided. You're now asking for something quite different - and with ambiguous specifications as well.

Clearly, if your user doesn't want a word replaced, it shouldn't be in the Find/Replace list in the workbook. If you're wanting the user to choose yes/no for every individual potential replacement, the code will need substantial revision. It might actually be more efficient for you user to review the tracked changes after the macro has done its job and reject the ones he doesn't want. That's likely to be a fairly trivial exercise compared to having to choose yes/no for every individual potential replacement.

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

I thought you were going to say that and that is exactly what I told him - that isn't what he asked for... I didn't know if it would be an easy fix or not, which is why I asked. Thank you so much for getting back to me on this. I will find out from him...

 

[ewornibor]

Alright, this is what he said and I sincerely apologize for him not being clear in what he wanted/needed:


need both words on the document (the original word that we were calling the "rescinded term")... I'm not replacing the words. I'm showing a suggestion. It's up to the original author to decide if my points are valid. The way it's set up now I can still use it for my creation. I just want a simple word/phrase finder with input of associated word/phrase inputted after original word. Highlighted in different colors. I may have misspoke with "replace" as the eventual intent have the author replace the word/phase with my suggestion. Word In-Word-Out track changes. I have to map out my suggestions on a comment matrix. So actually replacing the word is counterproductive for my review process. I have attached a copy of the Excel to show what I'm adding after the found word/phrase.

And of course he wanted them still to be color coded/highlighted like before.


The file's link is:

http://files.engineering.com/getfil...7-9394-5a92a524c8fa&file=BulkFindReplace.xlsx

 

[macropod]

If all you want is to add suggestions, perhaps you should consider using Comments instead of Track Changes or anything else that changes the body content. In that case, you'd replace everything between:
Application.ScreenUpdating = False
and:
Application.ScreenUpdating = True
with:

' Highlight & comment Rescinded Terms
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)
      .Replacement.Text = ""
      .Execute
    End With
    Do While .Find.Found
      .HighlightColorIndex = wdYellow
      .Comments.Add Range:=.Duplicate, Text:=Split(xlRList, "|")(i)
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next

Cheers
Paul Edstein
[MS MVP - Word]

 

[ewornibor]

His comments:
This Macro is perfect! Not what I asked for, but I love the Comment addition to my request. I can Also use this Macro for a multitude of other applications.



So, thank you so much for your help and I am sorry he kept changing his requirements.

 

[ewornibor]

He asked me a followup question: Can it look to four different spreadsheets and use a different highlight color? (and if so, I need to know how to do this, please) your help is greatly appreciated

These are the requested spreadsheets and their colors:
I have: Rescinded Army Terms: Highlight Red I need: Rescinded Joint Terms: Highlight Light Blue Also need: Contentious terms: Highlight Yellow And a: Miscellaneous: Highlight Light Green


This is the current code:

Sub ArmyRescindedTerms()
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim iDataRow As Long, xlFList, xlRList, i As Long
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\ArmyRescindedTerms.xlsx"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
Exit Sub
End If
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
On Error GoTo 0
With xlApp
'Hide our Excel session
.Visible = False
Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMru:=False)
If xlWkBk Is Nothing Then
MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
If bStrt = True Then .Quit
Exit Sub
End If
' Process the workbook.
With xlWkBk.Worksheets(StrWkSht)
' Find the last-used row in column A.
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
xlWkBk.Close False
.Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
' Process the data.
Application.ScreenUpdating = False

' Highlight & comment Rescinded Terms
For i = 1 To UBound(Split(xlFList, "|"))
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindStop
.Text = Split(xlFList, "|")(i)
.Replacement.Text = ""
.Execute
End With
Do While .Find.Found
.HighlightColorIndex = wdRed
.Comments.Add Range:=.Duplicate, Text:=Split(xlRList, "|")(i)
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
End Sub