Find-VBA Operation falling into an endless loop in tables

[andreas]

Dear Experts:

below macro counts the number of occurrences of bold formatting in a
document. It is running fine on documents WITHOUT tables. As soon as
there is a BOLD FORMATTED WORD within a TABLE, the macro falls into an
endless loop.

How do I have to change the code to include also tables?

Help is much appreciated. Thank you very much in advance.

Regards, Andreas


Sub CountNumber_FindOperation

Dim rngStory As range
Dim i As Long

Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory)
With rngStory.Find
.Font.Bold = True
While .Execute
i = i + 1
Wend
End With
If i > 0 Then
MsgBox "Occurrences of bold formatting found " & i & " time(s)."
Else
MsgBox "No bold formatting found", vbOKOnly, "No bold formatting!"
End If

End Sub

 

[Helmut Weber]

Hi Andreas,

i'm sorry, I can't reproduce the described behaviour.
Maybe adding two more lines:
While .Execute
rngStory.Select 'add
Stop 'add
i = i + 1
Wend
will help tracing down the problem.
--

Greetings from Bavaria, Germany

Helmut Weber

Vista Small Business, Office XP

 

[andreas]

Hi Andreas,

i'm sorry, I can't reproduce the described behaviour.
Maybe adding two more lines:
While .Execute
   rngStory.Select 'add
   Stop            'add
   i = i + 1
Wend
will help tracing down the problem.
--

Greetings from Bavaria, Germany

Helmut Weber

Vista Small Business, Office XP

Hi Helmut,

thank you for your quick help.

I still got this problem. I first thought my document was corrupted,
but I tried it out on several documents. It is still there. I also got
all Service Packs installed on my Office Suite 2003.

Anyhow, in the meantime I found out thru an Internet query that this
problem can be solved by simply move the range one character (see
below). There is one small drawback to this, the counting lists always
one instance more than there actually is.

Regards, Andreas


Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory)
rngStory.Find.Font.Bold = True
While rngStory.Find.Execute
i = i + 1
rngStory.Move , 1 'ADDED
Wend
If i > 0 Then
MsgBox "Occurrences of bold formatting found " & i & " time(s)."
Else
MsgBox "No bold formatting found", vbOKOnly, "No bold formatting!"
End If

 

[Greg Maxey]

Hi Helmut,

thank you for your quick help.

I still got this problem. I first thought my document was corrupted,
but I tried it out on several documents. It is still there. I also got
all Service Packs installed  on my Office Suite 2003.

Anyhow, in the meantime I found out thru an Internet query that this
problem can be solved by simply move the range one character (see
below). There is one small drawback to this, the counting lists always
one instance more than there actually is.

Regards, Andreas

Set rngStory = ActiveDocument.StoryRanges(wdMainTextStory)
rngStory.Find.Font.Bold = True
While rngStory.Find.Execute
  i = i + 1
  rngStory.Move , 1 'ADDED
Wend
If i > 0 Then
  MsgBox "Occurrences of bold formatting found " & i & " time(s)."
Else
  MsgBox "No bold formatting found", vbOKOnly, "No bold formatting!"
  End If- Hide quoted text -

- Show quoted text -

Try this:

Sub ScratchMacro()
Dim oRng As Word.Range
Dim bAdj As Boolean
Dim i As Long
bAdj = True
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Font.Bold = True
While .Execute
i = i + 1
If oRng.Information(wdWithInTable) Then
oRng.Move wdCharacter, 1
bAdj = True
End If
Wend
End With
If bAdj Then i = i - 1
MsgBox i
End Sub

 

[andreas]

Try this:

Sub ScratchMacro()
Dim oRng As Word.Range
Dim bAdj As Boolean
Dim i As Long
bAdj = True
Set oRng = ActiveDocument.Range
With oRng.Find
  .ClearFormatting
  .Font.Bold = True
  While .Execute
    i = i + 1
    If oRng.Information(wdWithInTable) Then
      oRng.Move wdCharacter, 1
      bAdj = True
    End If
  Wend
End With
If bAdj Then i = i - 1
MsgBox i
End Sub- Hide quoted text -

- Show quoted text -

Hi Greg,

it is working fine. Thank you very much for your professional help. I
really appreciate it. Regards, Andreas