Macro does not run properly

dherr · #1 02-19-2015, 03:48 AM

Hi,
I have the following VBA-Code:

Code:

Sub FindRedcoloredText()
Dim i As Integer
i = 0
Application.ScreenUpdating = False
Do
    With selection.Find
        .ClearFormatting
        .Font.color = wdColorRed
        .text = ""
        .Replacement.text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
        If .Found = True Then
            i = i + 1
            Debug.Print CStr(i) + ". " + selection.text + " " + CStr(selection.Range.ComputeStatistics(wdStatisticPages))
        Else
            Exit Do
        End If
    End With
Loop
Application.ScreenUpdating = True
End Sub

All words of my document should be found.
When I run this macro it finds sometimes 10, sometimes 1200, sometimes only 4 words which are colored red and then the macro runs 'out of time#, you see the waiting cursor of windows but nothing happens and I have to use Taskmanager to end Word. In the doc are about 3000 red words.
What can it be?

Regards-

Dietrich

gmayor · #2 02-19-2015, 05:54 AM

Try the following simpler code

Code:

Sub FindRedcoloredText()
Dim i As Long
Dim oRng As Range
    i = 0
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Font.Color = wdColorRed
        Do While .Execute(Forward:=True)
            i = i + 1
            Debug.Print CStr(i) + ". " & _
                        oRng.Text + " " & _
                        CStr(Selection.Range.ComputeStatistics(wdStatisticPages))
            DoEvents
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub

dherr · #3 02-19-2015, 08:50 AM

Hi Graham,
thank you for your code. Helped a lot!
I modified it this way:

Code:

Sub FindRedcoloredText()
    Dim i As Long
    Dim oRng As Range
    i = 0
    Set oRng = ActiveDocument.Range
    Application.ScreenUpdating = False
    With oRng.Find
        .Font.color = wdColorRed
        Do While .Execute(Forward:=True)
            i = i + 1
            Debug.Print CStr(i) + ". " & _
                        oRng.text + " " & _
                        CStr(oRng.Information(wdActiveEndPageNumber))
            DoEvents
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

So I can say: problem solved!
Greetings from Austria.
Dietrich

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Indentation Not Working Properly	LaC0saNostra	Word	2	02-01-2015 11:35 AM
Word won't open up properly	PattiChati	Word	1	12-18-2013 05:37 PM
How to properly indent in MSWORD2007	nungesh	Word	1	11-25-2013 04:26 PM
Word 2000 Macro not working properly	brianlb	Word VBA	1	07-01-2009 07:04 AM
Not printing properly	Louis	Outlook	0	08-05-2005 07:25 AM