Skip to main content
edited title
Link
Ahmed AU
  • 278
  • 2
  • 8

How to efficiently loop through paragraphs and make simple changes with Word VBA (Specially reverse loop to Delete Paragraphs)

Source Link
Ahmed AU
  • 278
  • 2
  • 8

How to efficiently loop through paragraphs and make simple changes with Word VBA

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.