Hello all,

I have this recurrent task where I need to search trough a document for a bunch of keywords and highlight them somehouw, preferred with a different color.
Of course I can do an Cntl-F enter text and search for it but the keywords are too much.

Let me explain it on a easy way,

Excel:
A list of cells (in one column) with keywords, say: green dog, big cat, small bird, green tree etc.

Word:
A portion of text where the spoken keywords may appear randomly.

Desired:
If a keyword (actually sentence because it can have multiple words) is found in the Word text it should be highlighted (preferrable a different color for keyword). Would be superduper if a cell in Excel near to the keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this and can tell me where to fing it.
Any help would be grateful!

Cheers,

Fred.

Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

oops sory,
replace
n = Application.Find("green", c)
by
n = Application.Find(keywords, c)

isabelle

Le 2016-10-19 Ã* 19:24, isabelle a écrit :
Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

....it would be better to specify "a part of the cell"
replace
Set c = .Find(keywords, LookIn:=xlValues)
by
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)

isabelle

Le 2016-10-19 Ã* 19:32, isabelle a écrit :
oops sory,
replace
n = Application.Find("green", c)
by
n = Application.Find(keywords, c)

isabelle

Le 2016-10-19 Ã* 19:24, isabelle a écrit :
Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

Thanks Isabelle!

I've tried it but without success.
I think it's not really jumping to Word to find the text isn't it?

I've used the following code:

Sub MacroIsab()
Dim keywords As String, c As Range, n As Integer
keywords = "verliep" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
n = Application.Find(keywords, c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

Hi Ronald,

Am Wed, 19 Oct 2016 12:51:32 -0700 (PDT) schrieb Ronald:

Excel:
A list of cells (in one column) with keywords, say: green dog, big cat, small bird, green tree etc.

Word:
A portion of text where the spoken keywords may appear randomly.

Desired:
If a keyword (actually sentence because it can have multiple words) is found in the Word text it should be highlighted (preferrable a different color for keyword). Would be superduper if a cell in Excel near to the keyword would display if the keyword was found or not.

open your Word doc. In Excel your keywords are in column A. Then try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With ActiveDocument.Content.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True,
Replace:=wdReplaceAll
End With
Next
End Sub

Set a reference to Microsoft Word xx.0 Object Library.


Regards
Claus B.
--
Windows10
Office 2016

@Claus,

Many thanks for your help!
It looks promising but an error still appear :-(

Run-time error '424':
Object required

This with the following line highlighted: "With ActiveDocument.Content.Find"

I had the Word document (word 2010) open with text in it. Tried with a new and saved document.

Any clue?


The code I've used is:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With ActiveDocument.Content.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
Next
End Sub

Hi Ronald,

Am Thu, 20 Oct 2016 02:39:16 -0700 (PDT) schrieb Ronald:

It looks promising but an error still appear :-(

Run-time error '424':
Object required

have you set a reference to Microsoft Word Library in VB editor?
Here it works without problems.

Try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object, myText As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
With myDoc
.Activate
.Visible = True
Set myText = .ActiveDocument.Content
End With
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With myText.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
Next
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Smoking!
That did the trick, wasn't aware of the existence of it. Thanks.
It works like a charm, really.

IF possible, and just as nice to have:
-Is it possible to mark on the Excel sheet (lets say column D) if the sentence was found?
-My list of sentences was 42 items long, the highlight color ran out of options and went grey for the last ones.

Like I said, IF possible I would be VERY happy with point 1 and can live without #2.

Again, thanks Claus!

Hi Ronald,

Am Thu, 20 Oct 2016 04:26:47 -0700 (PDT) schrieb Ronald:

IF possible, and just as nice to have:
-Is it possible to mark on the Excel sheet (lets say column D) if the sentence was found?
-My list of sentences was 42 items long, the highlight color ran out of options and went grey for the last ones.

try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object, myText As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
With myDoc
.Activate
.Visible = True
Set myText = .ActiveDocument.Content
End With
n = 4
For i = LBound(varText) To UBound(varText)
With myText.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
If .Found = True Then
ActiveSheet.Range("D" & i) = "Match found"
n = n + 1
End If
End With
Next
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Claus,

You should know that I really f*****g appreciate your help!
It will save time and easy up my work.

Thank you very much!