End of document marker?

K

Karen

Hi All,

I need some help with some code that sometimes works and sometimes enters an
infinite loop. Using the 'find' feature in Word, I want to find selections
highlighted in either red or turquoise. Depending on the color of the
highlight, I increment a counter either full value or half value. Sometimes
it works, sometimes it just keeps looping. I think the basic problem is
that I some way of find the end of the document to specify the range.

Here's the code:

Sub TestScoring()
Dim newcount As Single

'go to top of doc
Selection.HomeKey Unit:=wdStory

'clear previous find
Selection.Find.ClearFormatting
'set search for highlight on
Selection.Find.Highlight = True
'run search
Selection.Find.Execute
'while highlights are still found
While Selection.Find.Found = True
'if selection is red then count full value
If Selection.Range.HighlightColorIndex = wdRed Then
newcount = newcount + 1
'if selection is turquoise then count half value
ElseIf Selection.Range.HighlightColorIndex = wdTurquoise Then
newcount = newcount + 0.5
End If
'continue same search
Selection.Find.ClearFormatting
Selection.Find.Highlight = True
Selection.Find.Execute
'end loop when no more found
Wend
'move back to top of doc when done
Selection.HomeKey Unit:=wdStory
MsgBox (newcount)

End Sub

Any ideas?

Karen
 
G

Greg

Karen,

Couldn't duplicate your loop. Try:

Sub TestScoring2()
Dim newcount As Single
Dim oRng As Word.Range

Set oRng = ActiveDocument.Range

With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
Do While .Execute
If oRng.HighlightColorIndex = wdRed Then
newcount = newcount + 1
ElseIf oRng.HighlightColorIndex = wdTurquoise Then
newcount = newcount + 0.5
End If
oRng.Collapse direction:=wdCollapseEnd
Loop
End With
MsgBox newcount
End Sub
 
D

Dave Lett

Hi Karen,

I've revised the code somewhat--with Do While .Execute you don't need the
Selection.Find.Execute within the loop. The Select Case block is an efficient
way to read/write If...Elseif...ElseIf...End If statements. I find it a
little easier to read (so it's a personal preference in this case). To be
honest, I cannot figure out why your code loops infinitely. My test document
didn't have the problem with your routine.

Sub TestScoring()
Dim newcount As Single
Dim iMultHighlight As Single
With Selection
'go to top of doc
.HomeKey Unit:=wdStory
With .Find
'clear previous find
.ClearFormatting
'set search for highlight on
.Highlight = True
'run search while highlights are still found
Do While .Execute
Select Case Selection.Range.HighlightColorIndex
Case wdRed
newcount = newcount + 1
Case wdTurquoise
newcount = newcount + 0.5
Case 9999999 'when a selection has more than one highlight
color
iMultHighlight = iMultHighlight + 1
Case Else
'do nothing
End Select
Loop
'move back to top of doc when done
End With
End With
MsgBox (newcount) & vbTab & iMultHighlight

End Sub

HTH,
Dave
 
K

Karen

Dave,

Thanks very much, I tried yours and went into an infinite loop. This is
very frustrating!

Karen

Karen,

Couldn't duplicate your loop. Try:

Sub TestScoring2()
Dim newcount As Single
Dim oRng As Word.Range

Set oRng = ActiveDocument.Range

With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
Do While .Execute
If oRng.HighlightColorIndex = wdRed Then
newcount = newcount + 1
ElseIf oRng.HighlightColorIndex = wdTurquoise Then
newcount = newcount + 0.5
End If
oRng.Collapse direction:=wdCollapseEnd
Loop
End With
MsgBox newcount
End Sub
 
K

Karen

Hi Greg,

Thanks very much, I tried yours and went into an infinite loop. This is
very frustrating!

Karen

Karen,

Couldn't duplicate your loop. Try:

Sub TestScoring2()
Dim newcount As Single
Dim oRng As Word.Range

Set oRng = ActiveDocument.Range

With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
Do While .Execute
If oRng.HighlightColorIndex = wdRed Then
newcount = newcount + 1
ElseIf oRng.HighlightColorIndex = wdTurquoise Then
newcount = newcount + 0.5
End If
oRng.Collapse direction:=wdCollapseEnd
Loop
End With
MsgBox newcount
End Sub
 
K

Karen

Hi Greg,

Done. Any suggestions are welcome.

Karen Hagerman
University of Phoenix Online Faculty

(e-mail address removed)

Phone Number: 206-309-0438 (Leave a Message)

UOP Tech Support: 800-800-3493

E-mail me your document (without the macro). (e-mail address removed)
 
T

Tony Jollans

The setting of Selection.Find.Wrap controls what happens at the end of your
document. As you are not explicitly setting this it will have whatever value
it had on the previous Find which may be wdFindContinue. Try explicitly
setting it to wdFindStop.
 
G

Greg Maxey

Tony,

Karen sent me her document and I tied that. No joy

Her document consisted of several yellow highlighted areas, a few red and a
few turqoise. I did some testing with msgboxes and founded that it kept
looping to a zero length range with yellow hightlight applied afer
processing all the other expected found ranges. Her document contained alot
of embeded equations that appeared as empty yellow highlighted areas until
you put your mouse over one of them. I don't know but these might somehow
account for the empty range. Anyway I did a work around that she was
satisfied with:

Sub TestScoring2()
Dim i As Single
Dim oRng As Word.Range

Set oRng = ActiveDocument.Range

With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Highlight = True
Do While .Execute
Select Case oRng.HighlightColorIndex
Case wdRed
i = i + 1
Case wdTurquoise
i = i + 0.5
Case wdYellow
If Len(oRng.Text) = 0 Then Exit Do
Case Else
'Do Nothign
End Select
oRng.Collapse direction:=wdCollapseEnd
Loop
End With
MsgBox i
End Sub

I will send you her document if you want to take a crack at determining the
source of the empty range.

Greg Maxey
 
K

Karen

Hi Tony,

I had, in one of the iterations with the macro, worked with the
Selection.Wrap. I tried wdFindStop and that had no effect, I tried
wdFindAsk as a troubleshooting aid but the macro would lock up before the
message dialog could be activated. Greg is right, he certainly found what
was causing my macro to just cycle and cycle. The document does have
several yellow-highlighted text and Mathtype equation objects; those are the
answers. The red and turquoise highlighted items are either full value off
or partial value. I too wouldn't mind finding that zero-length,
yellow-highlighted item that makes the macro not work BUT Greg's code allows
this to work and I'm very pleased with it :)

--
Karen

"Tony Jollans" <My Forename at My Surname dot com> wrote in message
The setting of Selection.Find.Wrap controls what happens at the end of your
document. As you are not explicitly setting this it will have whatever value
it had on the previous Find which may be wdFindContinue. Try explicitly
setting it to wdFindStop.
 
T

Tony Jollans

Thank you Karen,

I can now reproduce this problem and am playing with it. I will post back if
I find anything of consequence.

Greg - thank you, but there is no need to send me the document now.
 
T

Tony Jollans

I was looking for something complex but it seems to me that Find in VBA has
problems when looking for formatting and always seems to end up in a loop on
the last match. The check for text length of zero happens to solve it in
this particular instance (I think because the MathType objects are Fields)
but doesn't help in the more general case which, I suspect, may require a
check for the found range being equal to the previous found range.
 
K

Karen

Tony,

You're right, turns out Greg's fix only worked with one type of document
so..... now I've added a teal-highlighted field at the end of the document
and one of the Case statements says that if the highlight is 'teal' then
'Exit Do'. It's a workaround but it works :)

Karen

"Tony Jollans" <My Forename at My Surname dot com> wrote in message
I was looking for something complex but it seems to me that Find in VBA has
problems when looking for formatting and always seems to end up in a loop on
the last match. The check for text length of zero happens to solve it in
this particular instance (I think because the MathType objects are Fields)
but doesn't help in the more general case which, I suspect, may require a
check for the found range being equal to the previous found range.
 
G

Greg Maxey

While I have tried and tried, I can't duplicate the continous loop in a
simple document with or without the zero range check.

If I type a few lines of text and hightlight some text red and some text
yellow it processes as expected with no continous loop.

I'm perplexed.
 
T

Tony Jollans

Looks like I made a silly mistake in my code - not for the first time -
which rather explains the startling result. I will try again and report
back.
 
K

Karen

Hi Greg,

When I first worked on the macro I used a simple doc and it worked. The
problem is that these docs are from other users so there is no control over
whatever 'odd' things might have happened. To go back to my initial post, I
thought if I could find some clear end of document marker then I could use
that, but I never could find one so........... now I create my own with the
teal-highlighted text and everything is working fine.

I really appreciate the time both you and Tony took to review the code,
offer suggestions and, in your case, actually troubleshot a 'real' doc with
the error.

Now, if I were king of Microsoft, I'd develop some sort of VBA end of
document marker :)

--
Karen
While I have tried and tried, I can't duplicate the continous loop in a
simple document with or without the zero range check.

If I type a few lines of text and hightlight some text red and some text
yellow it processes as expected with no continous loop.

I'm perplexed.
 
T

Tony Jollans

I cannot now recreate the problem at all - to be honest I can't be sure I
ever did.

If you still have the document, Greg, I would be interested to see it. I
never did get your e-mail - Tony at Jollans dot com.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Loop until end 1
Select Text to End of Footnote 9
VBA to Find Word or Phrase then Highlight Entire Paragraph that Follows 5
Word Macro for multiple searches, incl. in footnotes 2
Infinite Loop with a find and replace 2
modify ListAcronyms macro (for definitions before acronyms) 1
help with macro please 0
Spaces after 1 incorporate footnote 5

Top