how to highlight paragraphs that contain a given string of letters

[wZrokowiec]

I have a wonderful macro in Microsoft Word 2003 that I'm happy with
and I've used for many years but now .. I need a small modification.
The macro finds a given string of characters and removes the
paragraphs which encompass them. So far so good. But now I'd like the
macro NOT TO remove but to highlight the paragraphs with RED or GREEN
color. The procedure is as follows: --> find all the paragraphs with
"abcdef.." string of characters and change the color of the paragraph
(or the letters) to red/green.
Of course the strings of characters are given in a table in a separate
file (let's say 'c:/aaaaaa.com')
Is it an easy task to change it?
Here is the macro:

Sub xxx()
Dim Source As Document
Dim Ads As Document
Dim Signature As Range
Dim i As Long
Dim drange As Range
Set Ads = ActiveDocument
Set Source = Documents.Open("C:\Signatures.doc")
Ads.Activate
For i = 2 To Source.Tables(1).Rows.Count
Set Signature = Source.Tables(1).Cell(i, 1).Range
Signature.End = Signature.End - 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:=Signature.Text,
MatchWildcards:=False, _
Wrap:=wdFindContinue, Forward:=True) = True
Set drange = Selection.Paragraphs(1).Range
drange.Delete
Loop
End With
Next i

End Sub

Sincerely Yours
wZ

 

[Graham Mayor]

Basically you are processing the range drange, which is the paragraph
containing the word selected from your list.
The following will mark all the paragraphs containing words from the first
column of your table with a red highlight.
Unlike your other macro, this one does not ignore the first row of your data
table - so you don't need a header row.
If you prefer green, change wdRed to wdGreen

Dim Source As Document
Dim Ads As Document
Dim Signature As Range
Dim i As Long
Dim drange As Range
Set Ads = ActiveDocument
Set Source = Documents.Open("C:\aaaaaa.doc")
Ads.Activate
For i = 1 To Source.Tables(1).Rows.Count
Set Signature = Source.Tables(1).Cell(i, 1).Range
Signature.End = Signature.End - 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=Signature.Text, _
MatchWildcards:=False, Forward:=True) = True
Set drange = Selection.Paragraphs(1).Range
drange.HighlightColorIndex = wdRed
Loop
End With
Next i

 

[wZrokowiec]

Thank you very much indeed! Works great!

I tried to copy your macro twice (between: Sub ....... End Sub) so as
to have 2 possibilities:
1. finding words in a file C:/file_1.doc and highlighting to RED
2. finding words in a file C:/file_2.doc and highlighting to GREEN

But I failed. I have an error saying:
Compile Error: Duplicate Declaration in current scope.

Should I ignore this and make two separate macros with two separate
names or maybe is it easy to put them together but with a small
modification of the code?

Thank you
wZ

 

[Graham Mayor]

You have duplicated the DIM statements. You can't do that
If you add another column (column 2) to your table and add the words red or
green as appropriate then the following version will colour red for the
entries that have red and green for the rest.

Dim Source As Document
Dim Ads As Document
Dim Signature As Range
Dim Col As Range
Dim i As Long
Dim drange As Range
Set Ads = ActiveDocument
Set Source = Documents.Open("C:\aaaa.doc")
Ads.Activate
For i = 1 To Source.Tables(1).Rows.Count
Set Signature = Source.Tables(1).Cell(i, 1).Range
Signature.End = Signature.End - 1
Set Col = Source.Tables(1).Cell(i, 2).Range
Col.End = Col.End - 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(findText:=Signature.Text, _
MatchWildcards:=False, Forward:=True) = True
Set drange = Selection.Paragraphs(1).Range
If LCase(Col.Text) = "red" Then
drange.HighlightColorIndex = wdRed
Else
drange.HighlightColorIndex = wdGreen
End If
Loop
End With
Next i