Search and replace predefined sets of strings?

N

Nomey

Dear all,

I need to build a code to search a predefined set of strings in a document and replace them by another predefined set of strings.

Example:
strS is (vssen | vsen | vss | vss. | vs. | vs | v. | v )
strR is (vÿerÿssen | vÿerÿsen | etcetera...)

strS (search strings) and strR (replacement strings) have the same number of elements. The first element of strS should be replaced by the first element of strR, etcetera, but

1) how do I set a string variable to a limited list of search/replacement strings. Would that be an array? and
2) why does the .HighlightColorIndex = wdNoHighlight not compile in my first attempt (see below)?

Sub Vop()
Dim rTmp As Range
Set rTmp = ActiveDocument.Range
'declare variables for search and replace texts
Dim strS, strR As String
Dim lngC As Long
'for loop to execute F&R with all strings
With rTmp.Find
.Text = strS
.Replacement.Text = strR
'add .HighlightColorIndex = wdNoHighlight -> does not compile
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
While .Execute
rTmp.start = rTmp.End
rTmp.End = ActiveDocument.Range.End
Wend
End With
End Sub


Best regards - Shirley Nomey
 
N

Nomey

My next attempt, including my first array:

Dim rTmp As Range
Set rTmp = ActiveDocument.Range
Dim S, R As Variant
S = Array("vssen", "vsen", "vss", "vs", "v")
R = Array("vÿerÿssen", "vÿerÿsen", "vÿerÿs", "vÿerÿs", "vÿersÿ")
Dim i, U As Long
U = UBound(S)
For i = 0 To U
With rTmp.Find
.ClearFormatting
.Text = S(i)
.Replacement.Text = R(i)
'add .HighlightColorIndex = wdNoHighlight -> does not compile
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
While .Execute
rTmp.start = rTmp.End
rTmp.End = ActiveDocument.Range.End
Wend
End With
Next i

I still haven't figured out why .HighlightColorIndex = wdNoHighlight does not compile. And nothing is replaced, strangely.

Any ideas?
Cheers - Shirley
 
N

Nomey

And a working version FYI!

But I could still use a little help from you to apply this macro on a batch of Word files, if that's possible...

Dim S, R As Variant
S = Array("Vssen", _
"Vsen", _
"Vss ", _
"Vss. ", _
"Vs ", _
"Vs. ", _
"vssen", _
"vsen", _
"vss ", _
"vss. ", _
"vs ", _
"vs. ", _
"V. ")
R = Array("Vÿerÿssen", _
"Vÿerÿsen", _
"Vÿersÿen ", _
"Vÿersÿen ", _
"Vÿerÿs ", _
"Vÿerÿs ", _
"vÿerÿssen", _
"vÿerÿsen", _
"vÿersÿen ", _
"vÿersÿen ", _
"vÿerÿs ", _
"vÿerÿs ", _
"Vÿersÿ ")

Dim i, U As Long
U = UBound(S)

For i = 0 To U
With rTmp.Find
.ClearFormatting
.Text = S(i)
.Highlight = wdNoHighlight
.MatchWholeWord = True
.MatchCase = True
.MatchWildcards = False
.Replacement.ClearFormatting
.Replacement.Text = R(i)
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
Next i
 
N

Nomey

Hi Helmut,

Thanks, but I know those templates, and they are not what I need, I think. I just wanted to find a general sub for executing this macro on all files in a given folder. But thanks anyway. I've come so far already and it's just a matter of time for me to find the solution.

Apart from that, I've encounterd a new problem: If the strings I'm replacing are directly after a tab or a line break or after a stop-plus-a-space (that's a complicated way to say that they are at the beginning of a sentence), they should be written with an initial capital <sigh>. Any suggestions?

And how can I set a particular highlight color for replaced words? Still a lot to do, and I'm not even paid for it (I'm involved in a bible digitizing project).

Cheers,
Shirley
 
H

Helmut Weber

Hi Shirley,

a million ways to achieve the same goal,
and well tested other ways and improvements welcome.

How about that one?

If included "! ", "? ", ": " as well as ". " for capitalizing.

Sub Test2341()
Dim lTmp As Long
Dim sTmp As String
Dim lpos As Long
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "Es"
.MatchWholeWord = True
.MatchCase = True
While .Execute
' rDcm.Select ' for testing
lpos = rDcm.End
lTmp = Asc(rDcm.Characters.First.Previous)
sTmp = rDcm.Characters.First.Previous.Previous
rDcm.Text = "it"
rDcm.HighlightColorIndex = wdYellow
Select Case lTmp
Case 9, 11:
rDcm.Characters.First = UCase(rDcm.Characters.First)
End Select
If lTmp = 32 Then
Select Case sTmp
Case ".", "!", "?", ":"
rDcm.Characters.First = UCase(rDcm.Characters.First)
End Select
End If
rDcm.Start = lpos
rDcm.End = ActiveDocument.Range.End
Wend
End With
End Sub
 
N

Nomey

Hi Helmut,

And where does the replacement statement fit in, in your example?

Best regards,
Shirley
 
H

Helmut Weber

Hi Nomey,

I'm not using replacement at all,
as I don't think it is versatile enough here,
as often by the way,
but set the found range to a new value.

You got to build a loop around it all,
working it's way through your array,
substitute "Es" by array1(x) and
substitue "it" by array2(x).

I'm searching for "Es".
As long as found,
I remember the end of the found range
and set the found range to a new value.
I check the asc-number of the character preceding the new value.
- rdcm.characters.first.previous
If it is character 9 (tab) or character 11 (new line) then
I capitalize the first letter.
else
I check if it is a space, character(32).
if so, a further check has to be done
for the character preceding the space.
- rdcm.characters.first.previous.previous
if so, capitalize the first letter of rdcm.

etc.

I don't think it is easy going,
but I think as well, there is no easy going here.

I see possible complications, too,
in theory, but maybe they just don't apply to your text.
 
H

Helmut Weber

Hi Shirley,

this is my sample doc:
' --------------------------------- input
The quick
The? quick
The! quick
The. quick
The: quick
The quick
the, quick
The quick
The? quick
The! quick
The. quick
The: quick
The quick
the, quick
The quick
The? quick
The! quick
The. quick
The: quick
The quick
the, quick

The task is to replace "quick" by "fast"
and do the required capitalizing.
Hoping the tabs get across through the mail.

' --------------------------------- output

The Fast
The? Fast
The! Fast
The. Fast
The: Fast
The fast
the, fast
The Fast
The? Fast
The! Fast
The. Fast
The: Fast
The fast
the, fast
The Fast
The? Fast
The! Fast
The. Fast
The: Fast
The fast
the, fast

Have some fun.




--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP
 
N

Nomey

Hi Helmut,

Thanks again for your explanation. I've got the whole weekend to work on this macro, so I'll let you know how it goes. In my other thread ("Evaluating the previous and following character in a Search and Replace routine?") I've explained in detail what I am trying to achieve. Just in case you're interested.

Cheers,
Shirley
 
Top