asked on

Word VBA - looping slows down

Curious. I have this loop running on a Word document learning from Crystal's code (thanks Crystal I'm having an amazing day thanks to you). It has 411 pages and some 8,500+ paragraphs.

The loop starts off quite zippy. And then it gradually slows down with each loop. I'd like it to be zippy all the way through :)

Is this normal for a loop in VBA? ie. is there some memory management thing I should be doing? (is memory being clogged up with each loop?)

Sub LoopThroughParagraphs()

    'adapted from Crystal 20171217 on E-E
   
   Dim oWrd As Object _
      , oDoc As Object _
      , oTable As Object _
      , oBookmark As Object _
      , oRng As Object
    
   Dim nParaTotal As Long _
      , nCharTotal As Long _
      , nParaCurrent As Long _
      , nPosStart As Long _
      , nPosEnd As Long
      
   Dim sText As String _
      , sStyle As String _
      , iSection As Integer _
      , iPage As Integer _
      , i As Integer _
      , sMsg As String
   
   Dim strPara as string

   Dim booKeepGoing As Boolean
    
   Set oDoc = ActiveDocument
    
   'total number of paragraphs
   nParaTotal = oDoc.Paragraphs.Count
    Debug.Print "Paragraphs total = " & Format(nParaTotal, "#,##0")

   'total number of characters
   nCharTotal = oDoc.Characters.Count
    Debug.Print "Characters total = " & Format(nCharTotal, "#,##0")
        
   nPosStart = 1 'where to start
   nPosEnd = nCharTotal 'where to end
   nParaCurrent = 1
   
   'define a range from a character start position to end position
   'not used -- only here to demonstrate
   Set oRng = oDoc.Range(nPosStart, nCharTotal)
    
   booKeepGoing = True
   
   'loop through the document
   Do While booKeepGoing = True         '!! SLOWS DOWN WITH EACH ITERATION!!!

      'stop if the current paragraph number is greater than the document
      If nParaCurrent > nParaTotal Then
         booKeepGoing = False
         Exit Do
      End If
        
    strPara = oDoc.Paragraphs(nParaCurrent).Range.Text
    Debug.Print strPara 
        
      'increment the current paragraph counter
      nParaCurrent = nParaCurrent + 1           
      Debug.Print nParaCurrent
      
   Loop
   
    MsgBox "Done"

End Sub

Open in new window

SOLUTION

aikimark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

hindersaliva

ASKER

Thanks Graham and Aikimark. I refined my test and found that the Debug. Print seems to be the culprit. When I just looped and Debug.Printed only the time (in milliseconds) of each 1,000th it was a fairly constant .8 milliseconds per 1,000.

I take your point about For ... Each also.

hindersaliva

ASKER

Having said that ..... the mystery deepens!

Here are the results I get: Debug.Print on 1000, 2000, 3000, 4000, 5000

Do ... While

Elapsed time: 6.30485591204873E-02ms
Elapsed time: 3.30345124880134ms
Elapsed time: 4.46178524194518ms
Elapsed time: 5.44416976777603ms
Elapsed time: 6.43461864419205ms
Elapsed time: 7.36348520704854ms
Elapsed time: 8.24323254361348ms

For ... Each

Elapsed time: 7.89060048620703ms
Elapsed time: 964.346772940145ms
Elapsed time: 1484.66380455533ms
Elapsed time: 1541.24695387485ms
Elapsed time: 1594.85362470565ms
Elapsed time: 1645.19350042668ms
Elapsed time: 1702.32135997208ms

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub LoopThroughParagraphs_Counter()

    'Timer setup
    Dim StartTime As Currency
    Dim EndTime As Currency
    Dim TickFrequency As Currency
    
    QueryPerformanceFrequency TickFrequency
    QueryPerformanceCounter StartTime
    
    'document
    Dim oDoc As Object
    Dim nParaCurrent As Long
    Dim para As Paragraph
    
    Set oDoc = ActiveDocument
    
    nParaCurrent = 1
        
    Do Until nParaCurrent = 7000
    
        If nParaCurrent = 1 Or nParaCurrent = 1000 Or _
                                nParaCurrent = 2000 Or _
                                nParaCurrent = 3000 Or _
                                nParaCurrent = 4000 Or _
                                nParaCurrent = 5000 Or _
                                nParaCurrent = 6000 Then
            QueryPerformanceCounter EndTime
            Debug.Print "Elapsed time: " & 1000 * (EndTime - StartTime) / TickFrequency & "ms"
        End If
        
        nParaCurrent = nParaCurrent + 1
    
    Loop
    
End Sub



Sub LoopThroughParagraphs_ForEach()

    'Timer setup
    Dim StartTime As Currency
    Dim EndTime As Currency
    Dim TickFrequency As Currency
    
    QueryPerformanceFrequency TickFrequency
    QueryPerformanceCounter StartTime
    
    'document
    Dim oDoc As Object
    Dim nParaCurrent As Long
    Dim para As Paragraph
    
    Set oDoc = ActiveDocument
    
    nParaCurrent = 1
        
    For Each para In oDoc.Paragraphs
    
        If nParaCurrent = 1 Or nParaCurrent = 1000 Or _
                                nParaCurrent = 2000 Or _
                                nParaCurrent = 3000 Or _
                                nParaCurrent = 4000 Or _
                                nParaCurrent = 5000 Or _
                                nParaCurrent = 6000 Then
            QueryPerformanceCounter EndTime
            Debug.Print "Elapsed time: " & 1000 * (EndTime - StartTime) / TickFrequency & "ms"
        End If
        
        nParaCurrent = nParaCurrent + 1
    
    Next para
    
End Sub

Open in new window

All I changed is the looping type (one line)

I expected For ... Each to be faster.

aikimark

You are only setting the start time once.

hindersaliva

ASKER

aikimark, I can't see that. I ran the two Subs in a different order and got the same results I noted. I'm pretty sure I'm doing something wrong but I can't see what it is. I do expect For ... Each to be faster.

aikimark

lines 14 & 53:

QueryPerformanceCounter StartTime

Open in new window

You are only calling it once. All intervals will increase.

GrahamSkan

Instead of

If nParaCurrent = 1 Or nParaCurrent = 1000 Or _
                                nParaCurrent = 2000 Or _
                                nParaCurrent = 3000 Or _
                                nParaCurrent = 4000 Or _
                                nParaCurrent = 5000 Or _
                                nParaCurrent = 6000 Then

Open in new window

It is easier to write:

If nParaCurrent mod 1000 = 1 then

Open in new window

hindersaliva

ASKER

I'm still finding that Do While ... Loop is faster than For ... Next. (by a factor of 1000)

I know this is not what we expect, but my test above is showing this. I'm really curious as to what I have missed.