Evaluating the previous and following character in a Search and Replaceroutine?

[Nomey]

Hi all,

Is there a way to evaluate the character before and after the found string in a routine like this:


With rTmp.Find
.ClearFormatting
.Text = var1
.MatchWholeWord = True
.MatchWildcards = False
'evaluate character here?
.Replacement.ClearFormatting
.Replacement.Text = var2
.Execute Replace:=wdReplaceAll
End With



Something like:

If 'prevous charecter is a tab or a carriage return or ". " Then
'use a capital for the first character in the replacement string
Else 'use no initial capital in the replacement string
End If


Best regards,
Shirley

 

[fumei via OfficeKB.com]

You may need to give more precise details, but...

Sub CheckOutPrior()
Dim r As Range
Dim Var1 As String
Dim Var2 As String

Var1 = "wn"
Var2 = "yadda"

Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
Do While .Execute(Findtext:=Var1, Forward:=True) = True
r.MoveStart Unit:=wdCharacter, Count:=-1
If Left(r.Text, 1) = "o" Then
r.MoveStart Unit:=wdCharacter, Count:=1
r.Text = Var2
r.Collapse Direction:=wdCollapseEnd
End If
r.Collapse Direction:=wdCollapseEnd
Loop
End With
Set r = Nothing
End Sub


The second

r.Collapse Direction:=wdCollapseEnd

(after the the test of the prior character to see if it is "o" ) is VERY
VERY important. It is not there, this goes into an infinite loop.

So say you have:

The quick brown fox

The quick brawn fox

Notice in one case the prior character is "o", and in the other it is "a".

What the code does:

1. makes a Range object of the document
2. use Find with that range to look for "wn" - but could of course anything
3. moves the start of the found range "wn" (if found) one character to the
left
eg. it finds the "wn" in the first sentence above, anjd makes the range
"own"
4. test the first character - is it "o", or not
5. if it IS "o", then it moves the start BACK one character, in other words,
to the original found text (ie. "wn"), and replaces that with Var2 ("yadda")
6. collapses to the end, and continues on.
7. if it is NOT "o", it collapses to the end, and continues on.

Result?

The quick broyadda fox - "wn" is replaced with "yadda"

The quick brawn fox - nothing


The FIRST "wn" did have "o" as the character just before...so it got changed.

The SECOND "wn" did NOT have "o" as the character before...so the code does
nothing, and goes on to the next "wn".

Hope this helps. This is only one possible way of doing this. You do not
specific - and you should - precisely the logic requirements.

For example: are you looking for whole words? You do not say, just "found
string". If it is whole words, then the prior character will be a space. In
which case, exactly whyare you testing?

If it is not a whole word, then you are looking for characters IN a word. It
seems odd that you would replace some characters within a word. Not that it
is not a real possible requirement, but I am not precisely clear on what you
are trying to do.

 

[Nomey]

Hi Fumei,

Thanks for your extensive help. I'll give it a try with your code suggestions.

Cheers,
Shirley

 

[Nomey]

OK, let me try o explain a little better what I'm trying to achieve:

1) I want to replace the whole words in array S by the corresponding whole words in arrray R.
2) If the found word is preceded by a carriage return of a tab, it schould have an initial capital
AND
3) If the found word is followed by a full stop AND (a carriage return OR a space plus a carriage return), then the full stop should be maintained.
4) The change should be marked for visual control after running the macro.

So far, I have copied and pasted the following code, but it doesn't compile:

Dim rTmp As Range
Set rTmp = ActiveDocument.Range
'Before
Dim S, R As Variant
S = Array("Vssen", "Vsen", "Vss", "Vs", "V")
R = Array("Vÿerÿssen", "Vÿerÿsen", "Vÿersÿen", "Vÿerÿsen ", "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
While .Execute
With rTmp
rTmp.MoveStart unit:=wdCharacter, Count:=1
If Left(rTmp.Text, -1) = ^13 Then
.Replacement.Text = R(i)
Else
.Replacement.Text = LCase(R(i))
End If
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
End With
rDcm.start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
Next i

 

[Doug Robbins - Word MVP]

Try

Dim myrange As Range
Dim List1 As Variant
Dim List2 As Variant
List1 = Split("black#white", "#")
List2 = Split("red#blue", "#")
For i = 0 To UBound(List1)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=List1(i), Forward:=True, _
MatchWildcards:=False, MatchCase:=True, Wrap:=wdFindStop) =
True
Set myrange = Selection.Range
myrange.start = myrange.start - 1
If Left(myrange, 1) = vbCr Or Left(myrange, 1) = vbTab Then
myrange.start = myrange.start + 1
myrange.Text = List2(i)
myrange.Characters(1) = UCase(myrange.Characters(1))
Else
myrange.start = myrange.start + 1
myrange.Text = List2(i)
End If
Loop
End With
Next i


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Nomey]

Thanks Doug,

I've combined your code with my attempts, and it works brilliantly.

Still one challenge to go: where would you place a routine that evaluates whether the found array element is followed by a vbCr OR by a (full stop followed by a vbCr), and if that is the case, then keep the full stop, and if it isn't the case, eliminate it?

Cheers,
Shirley

And just to share the current version:

=================
Sub Vop()

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ÿersÿen", "vÿerÿs", "vÿersÿ")

Dim i As Long

For i = 0 To UBound(S)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=S(i), Forward:=True, _
MatchWildcards:=False, MatchCase:=False, Wrap:=wdFindStop) = True
Set rTmp = Selection.Range
rTmp.start = rTmp.start - 1
If Left(rTmp, 1) = vbCr Or Left(rTmp, 1) = vbTab Then
rTmp.start = rTmp.start + 1
rTmp.Text = R(i)
rTmp.Characters(1) = UCase(rTmp.Characters(1))
rTmp.HighlightColorIndex = wdBrightGreen
Else
rTmp.start = rTmp.start + 1
rTmp.Text = R(i)
End If
Loop
End With
Next i

End Sub

 

[Nomey]

And a working version:

Purpose:
1) Change strings in array S by respective strings in array R.
2) If the string is preceded by vbCr or vbTab -> use an initial cap.
3) If the string is not followed by a space or a comma, replace it.
4) If the string is followed by a) vbCr OR b) by a dot & a vbCr -> replace maintaining the full stop.

If you see a way to improve my code, you're most welcome to say so.

Best regards
Shirley

========================
Sub Vop3()

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ÿersÿen", "vÿerÿs", "vÿersÿ")

Dim i As Long

For i = 0 To UBound(S)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=S(i), Forward:=True, MatchWildcards:=False, MatchWholeWord:=True, MatchCase:=False, Wrap:=wdFindStop) = True
Set rTmp = Selection.Range
.Highlight = wdNoHighlight 'to prevent endless loops, just like matchwholeword = true
'evaluate 1 character before rTmp
rTmp.start = rTmp.start - 1
If Left(rTmp, 1) = vbCr Or Left(rTmp, 1) = vbTab Then
rTmp.start = rTmp.start + 1
rTmp.Text = R(i)
rTmp.Characters(1) = UCase(rTmp.Characters(1))
rTmp.HighlightColorIndex = wdBrightGreen
Else
rTmp.start = rTmp.start + 1 'restore start position of rTmp
'evaluate 2 characters after rTmp
rTmp.End = rTmp.End + 1 'rTmp +1

If Right(rTmp, 1) = " " Or Right(rTmp, 1) = "," Then
rTmp.End = rTmp.End - 1 'rTmp -1 (=0)
rTmp.Text = R(i)
rTmp.HighlightColorIndex = wdYellow
Else
If Right(rTmp, 1) = vbCr Then
rTmp.End = rTmp.End - 1 'rTmp -1 (=0)
rTmp.Text = R(i) & "."
rTmp.HighlightColorIndex = wdDarkYellow
Else
If Right(rTmp, 1) = "." Then 'if rTmp followed by stop
rTmp.End = rTmp.End + 1 'rTmp +1 (=2)
If Right(rTmp, 1) = vbCr Then 'if stop followed by vbCr
rTmp.End = rTmp.End - 2 'rTmp -2 (=0)
rTmp.Text = R(i)
rTmp.HighlightColorIndex = wdPink
Else 'if stop not followed by vbCr
rTmp.End = rTmp.End - 1 'rTmp -1 (=1)
rTmp.Text = R(i) 'don't know why???
rTmp.HighlightColorIndex = wdTurquoise
End If
End If
End If
End If
End If
Loop
End With
Next i

 

[Doug Robbins - Word MVP]

I am glad that you have that worked out because I did not understand the
criteria.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP