#1
|
|||
|
|||
Short loop takes no less than 12s to run, uses 25% CPU power!
Do you have any idea about what might cause the loop below to take no less than 12 seconds to run?
Code:
Dim iRev As Long For iRev = ActiveDocument.Range.Revisions.Count To 1 Step -1 Moreover, the code uses 25% CPU power (winword.exe process). I run it under Word 2016, on a Core 2 Quad 2.5 Ghz computer, and I'm using the code in a larger macro. All the other subroutines run very fast, except this one which takes so much time to execute. I made sure to test it in its own standalone subroutine to make sure it does not interfere with any other code. Any idea about what might be the problem, or where I should look for a possible solution to speed it up? I guess it should run in well under a second. Thank you! Alex |
#2
|
|||
|
|||
Try
Code:
Dim iRev As Long, Revisions_Count As Long Revisions_Count = ActiveDocument.Range.Revisions.Count For iRev = Revisions_Count To 1 Step -1 With ActiveDocument.Range.Revisions(iRev) End With Next iRev In your code, this property is evaluated 100 times on each loop. |
#3
|
|||
|
|||
Quote:
Alex |
#4
|
||||
|
||||
Putting the with/end with inside the loop doesn't look particularly efficient so I tried putting it outside and got significant speed improvements. It still doesn't run as fast as I would like but it's better than nothing.
Code:
Sub aTest() Dim iRev As Long With ActiveDocument.Range.Revisions For iRev = .Count To 1 Step -1 If iRev Mod 10 = 0 Then Debug.Print iRev, .Item(iRev).Type Next iRev End With MsgBox "Stage 1 done" For iRev = ActiveDocument.Range.Revisions.Count To 1 Step -1 With ActiveDocument.Range.Revisions(iRev) If iRev Mod 10 = 0 Then Debug.Print iRev, .Type End With Next iRev MsgBox "Stage 2 done" End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
||||
|
||||
With Word 2010 on my laptop, using:
Code:
Sub Test() ' Dimension Variables Dim eTime As Single, Rvn As Revision, i As Long ' Start Timing eTime = Timer With ActiveDocument.Range For Each Rvn In .Revisions With Rvn End With Next ' Calculate elapsed time eTime = (Timer - eTime + 86400) Mod 86400 ' Just in case execution time spans midnight MsgBox "Execution took " & Format(eTime / 86400, "hh:mm:ss") ' Start Timing eTime = Timer For i = 1 To .Revisions.Count With .Revisions(i) End With Next ' Calculate elapsed time eTime = (Timer - eTime + 86400) Mod 86400 ' Just in case execution time spans midnight MsgBox "Execution took " & Format(eTime / 86400, "hh:mm:ss") ' Start Timing eTime = Timer For i = .Revisions.Count To 1 Step -1 With .Revisions(i) End With Next ' Calculate elapsed time eTime = (Timer - eTime + 86400) Mod 86400 ' Just in case execution time spans midnight MsgBox "Execution took " & Format(eTime / 86400, "hh:mm:ss") End With End Sub Note: It's hardly surprising that a VBA routine might use about 25% (and no more) of a quad-core CPU's capacity.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
Andrew, Paul, thank you both very much!
I tested your solutions, and in my case, the only one that did improve the execution time was Paul's first loop. So, for the sake of clarity, here's the code I was using... Code:
Dim iRev As Long For iRev = ActiveDocument.Range.Revisions.Count To 1 Step -1 With ActiveDocument.Range.Revisions(iRev) With ActiveDocument.Range.Revisions(iRev) Select Case .Type Case wdRevisionDelete, wdRevisionCellDeletion ' ' more code here... ' .Reject End Select End With End With Next iRev And now, with a major speed improvement (thanks to Paul's code!), I'm using this... Code:
Dim iRev As Revision With ActiveDocument.Range For Each iRev In .Revisions With iRev Select Case .Type Case wdRevisionDelete, wdRevisionCellDeletion ' ' more code here... ' .Reject End Select End With Next End With Apart from the huge difference in execution time, there are no other differences in the end result. Alex |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Can i open a power point in design mode through a power point shoe | noora | PowerPoint | 4 | 12-10-2019 12:18 AM |
Google Docs Power Point Short cuts / Insert Image etc | Rado | PowerPoint | 4 | 04-11-2014 03:50 AM |
video loop lag in power point 2013 | drwrath | PowerPoint | 2 | 04-29-2013 05:53 PM |
Microsoft Power Point 2004 to Office Power Point 2007 | chuff | PowerPoint | 0 | 03-20-2011 01:23 PM |
mail merge takes and age | williebear | Outlook | 1 | 05-27-2009 11:32 PM |