Macro for creating a list of all highlighted words

[KGollan]

Hi,
Can anyone advise of a suitable macro for the following scenario:
A document has many words highlighted in different colours. I would like to
produce lists (in another document if possible) for each highlight colour, of
all the words that are highlighted with that colour.

Any advice would be appreciated.

Thanks,
Katy

 

[Helmut Weber]

Hi Katy,

A document has many words highlighted in different colours.
I would like to produce lists (in another document if possible)
for each highlight colour,
of all the words that are highlighted with that colour.

Any advice would be appreciated.

if so,
something along these lines:

Sub Test5()
Dim rDcm As Range
Dim lClr As Long ' color index
Dim Doc1 As Document
Dim Doc2 As Document
Set Doc1 = ActiveDocument
Set Doc2 = Documents.Add
Doc1.Activate
For lClr = 1 To 16
Doc2.Range.InsertAfter "colorindex: " & lClr & vbCr
Set rDcm = Doc1.Range
With rDcm.Find
.Highlight = True
While .Execute
If rDcm.HighlightColorIndex = lClr Then
Doc2.Range.InsertAfter rDcm.Text & vbCr
End If
Wend
End With
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[KGollan]

Thanks Helmut - that worked perfectly!

Hi Katy,



if so,
something along these lines:

Sub Test5()
Dim rDcm As Range
Dim lClr As Long ' color index
Dim Doc1 As Document
Dim Doc2 As Document
Set Doc1 = ActiveDocument
Set Doc2 = Documents.Add
Doc1.Activate
For lClr = 1 To 16
Doc2.Range.InsertAfter "colorindex: " & lClr & vbCr
Set rDcm = Doc1.Range
With rDcm.Find
.Highlight = True
While .Execute
If rDcm.HighlightColorIndex = lClr Then
Doc2.Range.InsertAfter rDcm.Text & vbCr
End If
Wend
End With
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Graham Mayor]

I had a similar plan, and your code was neater than mune, but I feel that it
would be more meaningful if real names were used eg

Sub ExtractHiLight()
Dim rDcm As Range
Dim lClr As Long ' color index
Dim sCol As String
Dim Doc1 As Document
Dim Doc2 As Document
Set Doc1 = ActiveDocument
Set Doc2 = Documents.Add
Doc1.Activate
For lClr = 1 To 16
Select Case lClr
Case 1
sCol = "Black"
Case 2
sCol = "Blue"
Case 3
sCol = "Turquoise"
Case 4
sCol = "Bright green"
Case 5
sCol = "Pink"
Case 6
sCol = "Red"
Case 7
sCol = "Yellow"
Case 8
sCol = "White"
Case 9
sCol = "Dark blue"
Case 10
sCol = "Teal"
Case 11
sCol = "Green"
Case 12
sCol = "Violet"
Case 13
sCol = "Dark red"
Case 14
sCol = "Dark yellow"
Case 15
sCol = "50% gray"
Case 16
sCol = "25% gray"
End Select

Doc2.Range.InsertAfter sCol & vbCr
Set rDcm = Doc1.Range
With rDcm.Find
.Highlight = True
While .Execute
If rDcm.HighlightColorIndex = lClr Then
Doc2.Range.InsertAfter vbTab & rDcm.Text & vbCr
End If
Wend
End With
Next
End Sub

I didn't get round to selectively inserting only the headers that were
actually used

 

[Helmut Weber]

Hi Graham,

the result of your code looks nicer
than mine because of the additional vbtab.

Also, I didn't feel like finding out
what numerical equivalent each colorindex has.
I usually leave such things to the original poster.

I didn't get round to selectively inserting
only the headers that were actually used

I don't think there is an elegant way to achieve that.
What possible ways there are you know as good as me,
and, certainly, you need no advice on that.

Schönen Abend noch.
(Have a nice evening.)

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Graham Mayor]

Word 2007's vba help documents the number equivalents of the color index
table as I found when I tried to reverse engineer your use of the numbers,
so it was a simple cut and paste job vba Help is somewhat improved over
the 2003 version.

I had been working on case statements using the colour names to achieve the
same ends but it produces a bulkier code which is why you got there first
I just adapted that to provide more descriptive headings.

I couldn't find an elegant way to selectively insert the headers either -
it's perhaps easier to remove the unwanted headers later, and that's what I
have done in my file copy.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Russ]

Kgollan,

Adding FirstFind in Graham's subroutine may help it to output only found
color text headings.

Sub ExtractHiLight()
Dim FirstFind as Boolean
Dim rDcm As Range
Dim lClr As Long ' color index
Dim sCol As String
Dim Doc1 As Document
Dim Doc2 As Document
If ActiveDocument.Content.HighlightColorIndex <> 0 then
Set Doc1 = ActiveDocument
Set Doc2 = Documents.Add
Doc1.Activate
For lClr = 1 To 16
FirstFind = True
Select Case lClr
Case 1
sCol = "Black"
Case 2
sCol = "Blue"
Case 3
sCol = "Turquoise"
Case 4
sCol = "Bright green"
Case 5
sCol = "Pink"
Case 6
sCol = "Red"
Case 7
sCol = "Yellow"
Case 8
sCol = "White"
Case 9
sCol = "Dark blue"
Case 10
sCol = "Teal"
Case 11
sCol = "Green"
Case 12
sCol = "Violet"
Case 13
sCol = "Dark red"
Case 14
sCol = "Dark yellow"
Case 15
sCol = "50% gray"
Case 16
sCol = "25% gray"
End Select


Set rDcm = Doc1.Range
With rDcm.Find
.Highlight = True
While .Execute
If rDcm.HighlightColorIndex = lClr Then
If FirstFind then
Doc2.Range.InsertAfter sCol & vbCr
FirstFind = False
End If
Doc2.Range.InsertAfter vbTab & rDcm.Text & vbCr
End If
Wend
End With
Next
Else
MsgBox "No Highlighting found."
End If
End Sub

 

[Graham Mayor]

That works fine - FirstFind is a new one to me - and I could not find a
reference to it?

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Russ]

Graham,
I didn't mean to imply that it was anything special or was part of VBA
syntax. It was just a generic Boolean variable that I arbitrarily named to
keep track of the first time through that piece of code for a color. It gets
toggled to False the first time through and it gets reset to True when the
number changes for the next color. It is just a programming technique, in
other words.

 

[Michael Bednarek]

That works fine - FirstFind is a new one to me - and I could not find a
reference to it?

It's a local variable which Russ introduced; see snippets below:

Adding FirstFind in Graham's subroutine may help it to output only
found color text headings.

Sub ExtractHiLight()
Dim FirstFind as Boolean [snip]
FirstFind = True [snip]
If FirstFind then
Doc2.Range.InsertAfter sCol & vbCr
FirstFind = False
End If

[snip]

 

[Graham Mayor]

That'll teach me to read the code more thoroughly before responding

 

[Graham Mayor]

Yes - foolish me, I missed the relevance. I was in a hurry to go out and
responded without reading the code properly

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

That works fine - FirstFind is a new one to me - and I could not
find a reference to it?

It's a local variable which Russ introduced; see snippets below:

Adding FirstFind in Graham's subroutine may help it to output only
found color text headings.

Sub ExtractHiLight()
Dim FirstFind as Boolean [snip]
FirstFind = True [snip]
If FirstFind then
Doc2.Range.InsertAfter sCol & vbCr
FirstFind = False
End If

[snip]

 

[Russ]

I'm afraid I'm guilty of that. Something will 'pop out' when I read a post
that I've dealt with recently, and the other relevant details, I seem to
skip over. In a rush to respond, often it is not until after I send a reply,
that I notice what I responded to, was out of context.

 

[Helmut Weber]

Hi Graham,

That works fine - FirstFind is a new one to me - and I could not find a
reference to it?

LOL

strange, I've been making the same mistake you made,
searching the groups and help for "Firstfind" for half an hour
and didn't find it.

 

[Graham Mayor]

I mean this as no criticism of Russ who is a much better programmer than me,
and from whom I have learned a lot, but the reason I overlooked it has much
to do with different programming styles. I tend to use an initial to
identify variables eg for boolean I would have called it bFirstfind.
Firstfind just seemed so right as a vba statement

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Russ]

Yes, I have strayed away from prefixing variables, probably in an effort to
save keystrokes when typing. I'm lazy, I admit it. I'll try to remember to
use them again, because it will even help me when I look at my own code
after being away from it for awhile. Thanks for the reminder.

Graham, I would also like to take this opportunity to thank you for how much
I have learn about using Word and programming from your website. You are
truly doing a great service for everyone.

 

[Graham Mayor]

Thanks for the kind comments. With the background of a technical writer I
can explain things I understand better than I can work them out. For that I
tend to leave it to people like yourself who can produce much tighter code.
My site is just a place where the good ideas are pulled together. I always
credit those whose code I 'borrow'.

I hope I can keep the web site going, however the running costs are rising
because of the traffic. The site gets over 2000 hits a day. At the moment
Google's AdSense is discreet and covers the costs, but for how much longer
...... I don't want to resort to more advertising or sponsorship, and the
logistics of moving the site to a cheaper service provider are for the
moment filed in the 'too hard to do' basket

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>