Auto mark entry for index purpose for an entire document

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Silvio - 09 Jun 2007 02:24 GMT

Hello, what I am trying to do is to write a macro that will mark all the
words in a very long document for so I can create and index when is done.
This macro should exclude marking words such as “the, or, and, if, also, I,
no, yes, etc. and other meaning less words that I can enter in the macro to
exclude. What I have done so far is this:

Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
ActiveWindow.ActivePane.View.ShowAll = False
ActiveDocument.Indexes.MarkEntry Range:=Selection.Range,
Entry:=Selection.Range, _
EntryAutoText:=Selection.Range, CrossReference:=""
Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub

It steel need to loop to the end of the document and I don’t know how, and
exclude specific words.

Any help is appreciate. Thank you in advance.
Silvio

Reply to this Message

Edward Thrashcort - 09 Jun 2007 12:58 GMT

Try something like this

Sub words()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim stopWords(1 To 100)
stopWords(1) = Chr(13)
stopWords(2) = "a"
stopWords(3) = "is"
stopWords(4) = "the"
stopWords(5) = "that"
stopWords(6) = "an"

For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To 100
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
End If
Next
If bUseThis Then
'Do the business here... e.g....
'oWord.Font.Color = wdColorRed
End If
Next
End Sub

Eddie

> *From:* Silvio<Silvio@discussions.microsoft.com>
> *Date:* Fri, 8 Jun 2007 18:24:00 -0700
[quoted text clipped - 18 lines]
> Any help is appreciate. Thank you in advance.
> Silvio

Reply to this Message

Silvio - 10 Jun 2007 02:55 GMT

About the loop?

> Try something like this
>
[quoted text clipped - 49 lines]
> > Any help is appreciate. Thank you in advance.
> > Silvio

Reply to this Message

Russ - 10 Jun 2007 03:16 GMT

If you remove the ' character from before the 'oWord... line and run his
macro, you will see that it formats each word a red color that is not a
stopWord. It is looping through each word of the document.

Try replacing that aforementioned commented line with...

ActiveDocument.Indexes.MarkEntry Range:= oWord.Range, _
Entry:= oWord.Range, _
EntryAutoText:= oWord.Range, CrossReference:=""

...To mark the words as index entries instead of making them the color red.

> About the loop?
>
[quoted text clipped - 51 lines]
>>> Any help is appreciate. Thank you in advance.
>>> Silvio

Signature

Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

Reply to this Message

Silvio - 10 Jun 2007 03:50 GMT

Thank you Russ, however when I try to run the macro I am getting the
following error message: “Compile Error: Method or data member not found.”
Then the .Range is highlighted in the first line you suggested
(ActiveDocument.Indexes.MarkEntry Range:=oWord.Range,)

This is what I have so far:

Sub words()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim stopWords(1 To 100)
stopWords(1) = Chr(13)
stopWords(2) = "a"
stopWords(3) = "is"
stopWords(4) = "the"
stopWords(5) = "that"
stopWords(6) = "an"

For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To 100
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
End If
Next
If bUseThis Then

ActiveDocument.Indexes.MarkEntry Range:=oWord.Range, _
Entry:=oWord.Range, _
EntryAutoText:=oWord.Range, CrossReference:=""

End If
Next

End Sub

> If you remove the ' character from before the 'oWord... line and run his
> macro, you will see that it formats each word a red color that is not a
[quoted text clipped - 63 lines]
> >>> Any help is appreciate. Thank you in advance.
> >>> Silvio

Reply to this Message

Russ - 10 Jun 2007 10:53 GMT

Oops, oWord was already set as a range, so oWord.Range was redundant.
Try this :
Sub words()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim bSetting As Boolean
Dim stopWords(1 To 100)
stopWords(1) = Chr(13)
stopWords(2) = "a"
stopWords(3) = "is"
stopWords(4) = "the"
stopWords(5) = "that"
stopWords(6) = "an"
bSetting = ActiveWindow.ActivePane.View.ShowAll
ActiveWindow.ActivePane.View.ShowAll = False
For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To 100
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
End If
Next
If bUseThis Then

ActiveDocument.Indexes.MarkEntry Range:=oWord, _
Entry:=oWord, _
EntryAutoText:=oWord, CrossReference:=""

End If
Next
ActiveWindow.ActivePane.View.ShowAll = bSetting
End Sub

It also makes sure that the index fields are hidden while looping through
the 'real' words and so doesn't see the field words and try to act on them.

You can open a blank document and type
=rand(1)
And hit enter to generate dummy text to test subroutine.

=rand(4,6)
Will generate even more dummy text.

> Thank you Russ, however when I try to run the macro I am getting the
> following error message: “Compile Error: Method or data member not found.”
[quoted text clipped - 101 lines]
>>>>> Any help is appreciate. Thank you in advance.
>>>>> Silvio

Signature

Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

Reply to this Message

Silvio - 10 Jun 2007 14:18 GMT

Thank you Russ, this works like a charm, you are the MAN!

> Oops, oWord was already set as a range, so oWord.Range was redundant.
> Try this :
[quoted text clipped - 146 lines]
> >>>>> Any help is appreciate. Thank you in advance.
> >>>>> Silvio

Reply to this Message

Russ - 10 Jun 2007 20:45 GMT

Your welcome for the small part I played, Edward did most of the work with
his subroutine.

> Thank you Russ, this works like a charm, you are the MAN!
>
[quoted text clipped - 150 lines]
>>>>>>> Any help is appreciate. Thank you in advance.
>>>>>>> Silvio

Signature

Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

Reply to this Message

Russ - 10 Jun 2007 22:13 GMT

Silvio,
Adding a redimension statement before each new stop word will keep the
stopWords array as small as possible and will limit the amount of looping
for each word in the document, therefore shortening the time it takes for
the subroutine to finish. Also note the change in the 'For' statement below.

Sub words()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim bSetting As Boolean
Dim stopWords() As String
ReDim stopWords(1)
stopWords(1) = Chr(13)
ReDim Preserve stopWords(UBound(stopWords) + 1)
stopWords(2) = "a"
ReDim Preserve stopWords(UBound(stopWords) + 1)
stopWords(3) = "is"
ReDim Preserve stopWords(UBound(stopWords) + 1)
stopWords(4) = "the"
ReDim Preserve stopWords(UBound(stopWords) + 1)
stopWords(5) = "that"
ReDim Preserve stopWords(UBound(stopWords) + 1)
stopWords(6) = "an"
bSetting = ActiveWindow.ActivePane.View.ShowAll
ActiveWindow.ActivePane.View.ShowAll = False
For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To UBound(stopWords) '** This changed too! **
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
End If
Next
If bUseThis Then

ActiveDocument.Indexes.MarkEntry Range:=oWord, _
Entry:=oWord, _
EntryAutoText:=oWord, CrossReference:=""

End If
Next
ActiveWindow.ActivePane.View.ShowAll = bSetting
End Sub

> Your welcome for the small part I played, Edward did most of the work with
> his subroutine.
[quoted text clipped - 155 lines]
>>>>>>>> Any help is appreciate. Thank you in advance.
>>>>>>>> Silvio

Signature

Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

Reply to this Message

Russ - 10 Jun 2007 23:55 GMT

Silvio,
Here is another method which may be faster. It uses that fact that index
marking can't see hidden text font normally when hidden, so the subroutine
hides all the unwanted words before marking words for indexing. It then
changes all font in document to unhidden.

Sub words2()
Dim oWord As Range
Dim oRange As Range
Dim bSetting As Boolean

Application.ScreenUpdating = False
Set oRange = ActiveDocument.Range(0, 0)
With oRange.Find
.MatchWholeWord = True
.MatchCase = False
.Replacement.Font.hidden = True
.Replacement.Text = "^&"
.Text = "^13" 'use \n in MacWord
.Execute replace:=wdReplaceAll
.Text = "a"
.Execute replace:=wdReplaceAll
.Text = "is"
.Execute replace:=wdReplaceAll
.Text = "the"
.Execute replace:=wdReplaceAll
.Text = "that"
.Execute replace:=wdReplaceAll
.Text = "an"
.Execute replace:=wdReplaceAll
End With
bSetting = ActiveWindow.ActivePane.View.ShowAll
ActiveWindow.ActivePane.View.ShowAll = False
For Each oWord In ActiveDocument.Range.Words
ActiveDocument.Indexes.MarkEntry Range:=oWord, _
Entry:=oWord, _
EntryAutoText:=oWord, CrossReference:=""
Next
ActiveWindow.ActivePane.View.ShowAll = bSetting
ActiveDocument.Range.Font.hidden = False
Application.ScreenUpdating = True
End Sub

> Silvio,
> Adding a redimension statement before each new stop word will keep the
[quoted text clipped - 201 lines]
>>>>>>>>> Any help is appreciate. Thank you in advance.
>>>>>>>>> Silvio

Signature

Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

Reply to this Message

Edward Thrashcort - 11 Jun 2007 08:51 GMT

Actually, a "cleaner" method (from the coding point of view) would have been
to exit the for loop once the condition had been met.

*From:* IdontWantSpam@nospam.net (Edward Thrashcort)
*Date:* Sat, 9 Jun 2007 12:58 +0100 (BST)

Try something like this

Sub words()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim stopWords(1 To 100)
stopWords(1) = Chr(13)
stopWords(2) = "a"
stopWords(3) = "is"
stopWords(4) = "the"
stopWords(5) = "that"
stopWords(6) = "an"

For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To 100
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
Exit For '***** HERE *****
End If
Next
If bUseThis Then
'Do the business here... e.g....
'oWord.Font.Color = wdColorRed
End If
Next
End Sub

Eddie

Reply to this Message

Silvio - 10 Jun 2007 03:08 GMT

Eddie thank you for you help, however it does not seem to work for me, it
does not exclude the words in list and it does not look to the end of the
document. This is what I have (please understand that I am not an expert in
write codes):

Sub Test()
Dim i
Dim oWord As Range
Dim bUseThis As Boolean
Dim stopWords(1 To 100)
stopWords(1) = Chr(13)
stopWords(2) = "a"
stopWords(3) = "is"
stopWords(4) = "the"
stopWords(5) = "that"
stopWords(6) = "an"

For Each oWord In ActiveDocument.Range.words
bUseThis = True
StatusBar = oWord.Text
For i = 1 To 100
If LCase(Trim(oWord.Text)) = LCase(stopWords(i)) Then
bUseThis = False
End If
Next
If bUseThis Then
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
ActiveWindow.ActivePane.View.ShowAll = False
ActiveDocument.Indexes.MarkEntry Range:=Selection.Range,
Entry:=Selection.Range, _
EntryAutoText:=Selection.Range, CrossReference:=""
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
Next

End Sub

Reply to this Message