This is regarding my answer with SO post How to remove paragraph marks with different format in MS-Word.
My primary question, is there any way performance of the code could be improved to operate on document as intended by OP (2.2 MB and has 2.1K pages, 871K words, 4,6M characters including spaces)?
On Secondary, is there a simple way or workaround that I am missing (and making things unnecessary complicated) to perform the sane task efficiently?
Here I reproduce my code after adding some futile measures to improve performance of the code with file of the size specified by the OP.
Option Explicit
Sub ReplacePara()
Dim Para As Paragraph, Xstr As String, Rng As Range
Dim i As Long, ln As Long, tm As Double, PrCnt As Long
Dim PrvChrSize As Integer, NextChrSize As Integer
Dim PrvChrFont As String, NextChrFont As String
Dim PrvChrItalic As Boolean, NextChrItalic As Boolean
tm = Timer
‘Following measures added to improve performance
‘but on the contrary it’s found instead of increasing time taken
Application.ScreenUpdating = False
With Options
.Pagination = False
.CheckSpellingAsYouType = False
.CheckGrammarAsYouType = False
End With
With ActiveDocument
PrCnt = .Paragraphs.Count
Debug.Print PrCnt
For i = .Paragraphs.Count To 1 Step -1
Set Para = .Paragraphs(i)
ln = Para.Range.Characters.Count
If ln > 1 Then
With Para.Range.Characters(ln - 1).Font
PrvChrSize = .Size
PrvChrFont = .Name
PrvChrItalic = .Italic
End With
If i < .Paragraphs.Count Then
With .Paragraphs(i + 1).Range.Characters(1).Font
NextChrSize = .Size
NextChrFont = .Name
NextChrItalic = .Italic
End With
Else
NextChrSize = 0
NextChrFont = ""
NextChrItalic = False
End If
End If
'Debug.Print i, PrvChrSize, PrvChrFont, NextChrSize, NextChrFont
If (PrvChrSize = 15 And (PrvChrFont = "Arial" Or PrvChrItalic = True)) _
And (NextChrSize = 15 And (NextChrFont = "Arial" Or NextChrItalic)) Then
Para.Range.Characters(ln).Text = " "
End If
.UndoClear
'If PrCnt < 1000 Then Debug.Print i & "/" & PrCnt
Next
End With
With Options
.Pagination = True
.CheckSpellingAsYouType = True
.CheckGrammarAsYouType = True
End With
Application.ScreenUpdating = True
Debug.Print " Seconds taken:" & Timer - tm
End Sub
The added measures actually found to increase time taken (from 3 odd minutes to 4 odd minutes) with documents of 124 pages. I haven’t ventured far to go for LockWindowUpdate
API.
Though the code tested Ok with documents of 100 pages around. I could not finish the task with a makeshift giant file of around 2.4 K pages. It is virtually crashing Word (not recovering from ‘Not responding mode’). I ceated the file with a simple code stub with the sample file linked by OP in the SO post. Code stub was also produced for ease is testing.
Sub makebig()
Dim Rng As Range, MyRange As Range
Dim Wd As Document
Dim i As Long
Set Wd = ThisDocument
Set Rng = Wd.Content
Rng.Copy
For x = 1 To 2000
Set MyRange = Wd.Content
MyRange.EndOf Unit:=wdStory, Extend:=wdMove
MyRange.Paste
Next
End Sub
Running the code with sample file twice (1st time with For x = 1 To 2000
and second time with For x = 1 To 1
) will produce a file about 2.4 K pages. For getting a file of 124 pages from the sample file 200 loops are sufficient.
For Each
loop instead of using by index. It should be faster iterating over a collection with for each vs index. \$\endgroup\$