Word Macro Text replacement help please

[mack2000]

I am trying to write some code to look for certain words in the documents and replace those individual words with a selection of other words.
Just as a start, if anyone can suggest how to select and replace a specific word (eg 'good') only if it doesn't have a bracket ( for example { good }, or any other chosen character) one or 2 characters before it, that would be a great help.
At the moment I am looping through an array of words, however it then loops through the newly added words and embeds replacements for those also - I want it to stop if it has already replaced the one word - maybe the code will make more sense, and thanks for any help.
The end result would be to find certain words in a document and replace them with all the words in the array the word is part of inside of brackets.

Sub Changer()

Dim rngStory As Range
Dim varData As Variant
Dim Arrayitem
Dim Arraypart
Dim Arraymetapart
Dim StrNewText
varDataGood = Array("Good", "Excellent", "Great")
varDataThink = Array("Think", "Consider", "Muse upon")
varFullArray = Array(varDataGood, varDataThink)

StrNewText = "{ "
For Each Arrayitem In varDataGood
StrNewText = StrNewText & Arrayitem & " | "
Next Arrayitem
StrNewText = StrNewText & " }"

For Each rngStory In ActiveDocument.StoryRanges

For Each Arraypart In varFullArray

For Each Arraymetapart In Arraypart

With rngStory.Find

.Text = Arraymetapart

.Replacement.Text = StrNewText

.Wrap = wdFindContinue

.Execute Replace:=wdReplaceAll

End With

Next Arraymetapart

Next Arraypart

Next rngStory


End Sub

[Tinbendr]

One approach would be to search for the bracketed word first (along with the brackets), replace it with another word (maybe reverse the string, but beware of palindromic words (http://www.usingenglish.com/glossary/palindrome.html).), replace the same word without the brackets, then change the reversed words back to normal.

[mack2000]

I like the thinking - the only issue is that initially I am going through the document replacing the words with a few words in brackets - the problem is that the words being searched for in the array are the ones being put into the brackets and when it loops through the second time it then changes the already changed words (sorry it is difficult to describe easily). Basically I want it to stop changing and words that have already been changed - I wondered if there is a way of doing a conditional clause so that once the word is found it can go back 2 characters and check to see if there is a bracket and if so not to change that word. If there is a way, I'm not clear how to do it in vb for the word document and would really appreciate advice. Thank you

[Tinbendr]

Could you provide us a sample document?

[mack2000]

Macro needs to identify certain commonly used words like ‘good’, ‘communication’, ‘tough’ and other lists of words that will be added and change the text to
My thought was to create arrays of words, loop through them checking the document and replacing, however it then find the words already changed and recycles through those also and now I’m a little stuck!

[mack2000]

This is the file after changed.
Thank you for your help

[macropod]

Hi mack2000,

I'd suggest taking a two-stage approach:
1. Use Find/Replace to replace each 'Find' string with a 'token' character from the higher end of the ASCII range, using only characters that would not otherwise appear in the document.
2. Use Find/Replace to replace each'token' character with your replacement string.
That way, you can avoid having one Find/Replace result overwriting the other.

[fumei]

I am not quite following. Are you saying you only want the action to happen once?

So if you have { good} say five times, you only want the first found instance changed, and the remaining to stay as { good }?

[mack2000]

I want to change all occurrences of words in the document, however if there are certain words like 'good' or 'excellent' or 'great' anywhere in the document, I want them replaced with { good | excellent | great } each time. This will be for quite a lot of different words that will be added to eg 'joyous' or 'happy' or 'ecstatic' would be replaced with { joyous | happy | ecstatic } - basically like building a kind of thesaurus that runs through the document showing all meanings.
The problem with repeating words was that I tried to build the search words into arrays and then looped through looking for them.
The first loop was fine - 'good' became { good | excellent | great }, and excellent became { good | excellent | great }, however because it looped through the array items it then changed the original word 'good' to { good | { good | excellent | great } | { good | excellent | great } } because it then detected the next word in the array which was added in the first loop.Basically when it has changed a word one time, I don't want it to change anything added again.
Maybe looping through the array isn't the right way to go, but I am really stuck and really appreciate all the help.
The suggestion earlier about changing any words in a specific array eg 'good' or 'great' or 'excellent' into a 'token' character the first time round and then going back through changing the 'token' characters into the desired string sounds like a good track - I just need to try to work out the coding.

[fumei]

Ah, I understand now.

1.. You look for { good } and replace it with { good | excellent | great }

2. You look for { excellent } but now those NEW "excellent" are found.

I believe the easiest way is the use of specialized tokens, that are replaced at ther end.

Technically, there are other possible routes:

1. doing a Len count between the { } and if it is the length of the group { good | excellent | great } skip that .Found.

2. building another array of the .Found ranges

but either of those would involve a lot more fussing.

Tokens is the easiest.

[fumei]

BTW: I would strongly recommend you fully declare ALL variables. Are you using Option Explicit?

[TonyJollans]

I'm not good with them, but regular expressions could help here.

Sub RegEx()

Dim RegExp As Object

Dim Choices(), ndx As Long
ReDim Choices(0 To 0)

ReDim Preserve Choices(LBound(Choices) To UBound(Choices) + 1)
Choices(UBound(Choices)) = Array("good", "great", "excellent")

ReDim Preserve Choices(LBound(Choices) To UBound(Choices) + 1)
Choices(UBound(Choices)) = Array("rough", "tough", "difficult")

ReDim Preserve Choices(LBound(Choices) To UBound(Choices) + 1)
Choices(UBound(Choices)) = Array("communicating", "communication")

Set RegExp = CreateObject("VBScript.RegExp")

For ndx = 1 To UBound(Choices)

With RegExp
.IgnoreCase = True
.Global = True
.Pattern = "(" & Join(Choices(ndx), "|") & ")"
ActiveDocument.Range.Text = _
.Replace(ActiveDocument.Range.Text, "{ " & Join(Choices(ndx), " | ") & " }")
End With

Next ndx

End Sub

[Tinbendr]

This seems to work.

Sub MultipleChoice()
Changer2
Changer3
End Sub
Sub Changer2()

Dim rngStory As Range
Dim varData As Variant
Dim Arrayitem
Dim Arraypart
Dim Arraymetapart
Dim StrNewText
Dim Counter As Integer 'Long for Gerry
varDataGood = Array("Good", "Excellent", "Great")
varDataThink = Array("Think", "Consider", "Muse upon")
varFullArray = Array(varDataGood, varDataThink)

Counter = 0
For Each rngStory In ActiveDocument.StoryRanges
For Each Arraypart In varFullArray

StrNewText = "{ "

For Each Arrayitem In varFullArray(Counter)
StrNewText = StrNewText & Arrayitem & " | "
Next Arrayitem
'Take off the extra pipe.
StrNewText = Left(StrNewText, Len(StrNewText) - 3)
StrNewText = StrNewText & " }"
Counter = Counter + 1
For Each Arraymetapart In Arraypart
With rngStory.Find
.Text = Arraymetapart
.Replacement.Text = StrReverse(StrNewText)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next Arraymetapart
Next Arraypart
Next rngStory
End Sub
Sub Changer3()

Dim rngStory As Range
Dim varData As Variant
Dim Arrayitem
Dim Arraypart
Dim Arraymetapart
Dim varFullArray
Dim StrNewText
Dim Counter As Integer 'Long for Gerry
varDataGood = Array("Good", "Excellent", "Great")
varDataThink = Array("Think", "Consider", "Muse upon")
varFullArray = Array(varDataGood, varDataThink)

Counter = 0
For Each rngStory In ActiveDocument.StoryRanges
For Each Arraypart In varFullArray

StrNewText = "{ "

For Each Arrayitem In varFullArray(Counter)
StrNewText = StrNewText & Arrayitem & " | "
Next Arrayitem
'Take off the extra pipe.
StrNewText = Left(StrNewText, Len(StrNewText) - 3)
StrNewText = StrNewText & " }"

Counter = Counter + 1

For Each Arraymetapart In Arraypart
With rngStory.Find
.Text = StrReverse(StrNewText)
.Replacement.Text = StrNewText
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next Arraymetapart
Next Arraypart
Next rngStory
End Sub

[mack2000]

Thank you - that is great.