none
How to Increase macro running speed? RRS feed

  • Question

  • Hi,

    I've a macro to find few criteria.

    a. Font = Bold
    b. Space Before <> 10
    c. Space Before <> 20
    d. Table = False

    Please see below code for more details.

    Private Sub Demo()
    Dim oPar As Paragraph
    Dim oRng As Word.Range
    For Each oPar In ActiveDocument.Paragraphs
    Set oRng = oPar.Range
        With oRng
           With .Find
                .ClearFormatting
                .Text = "^013"
                .MatchWildcards = True
                .Execute
           End With
           Set oRng = oPar.Range
           If oPar.Range.Font.Bold = True Then
             If oPar.Range.Paragraphs.SpaceBefore <> 10 Then
             If oPar.Range.Paragraphs.SpaceBefore <> 20 Then
                If oPar.Range.Information(wdWithInTable) = False Then
                   If .Find.Found Then
                 .Select
                  Selection.Comments.Add Range:=Selection.Range
                  Selection.TypeText Text:="Check!"
                  Set oRng = Nothing
                   End If
                End If
              End If
              End If
           End If
        End With
    Next
    End Sub

    This macro is works for me very well. But getting some time to complete the process. Is there any other methods to increase the speedup this same process.

    Any inputs would be much appreciated.


    .

    Tuesday, August 16, 2016 2:54 PM

Answers

  • Does this work faster? It performs fewer useless actions.

    Private Sub Demo()
        Dim sngSpace As Single
        Dim oPar As Paragraph
        Dim oRng As Range
        Application.ScreenUpdating = False
        For Each oPar In ActiveDocument.Paragraphs
            Set oRng = oPar.Range
            If Not oRng.Information(wdWithInTable) Then
                If oRng.Font.Bold = True Then
                    sngSpace = oPar.SpaceBefore
                    If sngSpace <> 10 And sngSpace <> 20 Then
                        ActiveDocument.Comments.Add _
                            Range:=ActiveDocument.Range(oRng.End - 1, oRng.End), _
                            Text:="Check!"
                    End If
                End If
            End If
        Next oPar
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Sam1085 Tuesday, August 16, 2016 8:06 PM
    Tuesday, August 16, 2016 3:52 PM
  • You might try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, t As Long
    With ActiveDocument
      t = .Tables.Count
      If t = 0 Then
        Call ProcessRange(.Range)
      Else
        Call ProcessRange(.Range(0, Tables(1).Range.Start))
        For i = 2 To t
          Call ProcessRange(.Range(Tables(i - 1).Range.End, Tables(i).Range.Start))
        Next
        Call ProcessRange(.Range(Tables(t).Range.End, .Range.End))
      End If
    End With
    Application.ScreenUpdating = True
    End Sub

    Sub ProcessRange(Rng As Range)
    Dim i As Long, StrCmt As String
    With Rng
      For i = 1 To .Paragraphs.Count
        With .Paragraphs(i).Range
          If Len(.Text) > 1 Then
            StrCmt = ""
            If .Font.Size <> 10 Then
              StrCmt = "Check font"
            End If
            If .Font.Bold = True Then
              If Abs(.ParagraphFormat.SpaceBefore - 15) <> 5 Then
                If StrCmt <> "" Then StrCmt = StrCmt & vbCr
                StrCmt = StrCmt & "Check format"
              End If
            End If
            If StrCmt <> "" Then .Comments.Add .Duplicate, StrCmt
          End If
        End With
      Next
    End With
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]





    • Marked as answer by Sam1085 Wednesday, August 17, 2016 1:08 PM
    • Edited by macropodMVP Thursday, August 18, 2016 1:49 AM Revised code
    Tuesday, August 16, 2016 10:34 PM

All replies

  • Does this work faster? It performs fewer useless actions.

    Private Sub Demo()
        Dim sngSpace As Single
        Dim oPar As Paragraph
        Dim oRng As Range
        Application.ScreenUpdating = False
        For Each oPar In ActiveDocument.Paragraphs
            Set oRng = oPar.Range
            If Not oRng.Information(wdWithInTable) Then
                If oRng.Font.Bold = True Then
                    sngSpace = oPar.SpaceBefore
                    If sngSpace <> 10 And sngSpace <> 20 Then
                        ActiveDocument.Comments.Add _
                            Range:=ActiveDocument.Range(oRng.End - 1, oRng.End), _
                            Text:="Check!"
                    End If
                End If
            End If
        Next oPar
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by Sam1085 Tuesday, August 16, 2016 8:06 PM
    Tuesday, August 16, 2016 3:52 PM
  • Hi Hans,

    Thanks for the response. I tried your code now. But it seems like take more time to complete.

    Earlier: 15s/8pages
    Now: 10s/8pages

    Earlier: 180s/50pages
    Now: More than 5min/50pages


    .

    Tuesday, August 16, 2016 4:58 PM
  • In that case, I'm afraid you'll have to use your original code and live with it.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Tuesday, August 16, 2016 6:53 PM
  • Thank you Sir for your valuable time!

    I think different office versions have different functions and process running speeds. I think that's the reason of that.

    I just run your code in 2016 office installed machine for 50pages. It took 20s to complete the process.

    Anyway Thanks for your quick answer. I've marked it as an answer now because it's compatible with latest MS Office versions.

    Thanks!


    .

    Tuesday, August 16, 2016 8:06 PM
  • You might try:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, t As Long
    With ActiveDocument
      t = .Tables.Count
      If t = 0 Then
        Call ProcessRange(.Range)
      Else
        Call ProcessRange(.Range(0, Tables(1).Range.Start))
        For i = 2 To t
          Call ProcessRange(.Range(Tables(i - 1).Range.End, Tables(i).Range.Start))
        Next
        Call ProcessRange(.Range(Tables(t).Range.End, .Range.End))
      End If
    End With
    Application.ScreenUpdating = True
    End Sub

    Sub ProcessRange(Rng As Range)
    Dim i As Long, StrCmt As String
    With Rng
      For i = 1 To .Paragraphs.Count
        With .Paragraphs(i).Range
          If Len(.Text) > 1 Then
            StrCmt = ""
            If .Font.Size <> 10 Then
              StrCmt = "Check font"
            End If
            If .Font.Bold = True Then
              If Abs(.ParagraphFormat.SpaceBefore - 15) <> 5 Then
                If StrCmt <> "" Then StrCmt = StrCmt & vbCr
                StrCmt = StrCmt & "Check format"
              End If
            End If
            If StrCmt <> "" Then .Comments.Add .Duplicate, StrCmt
          End If
        End With
      Next
    End With
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]





    • Marked as answer by Sam1085 Wednesday, August 17, 2016 1:08 PM
    • Edited by macropodMVP Thursday, August 18, 2016 1:49 AM Revised code
    Tuesday, August 16, 2016 10:34 PM
  • Thanks Paul for the answer.

    But I got a compile error (Sub or Function Not Defined) on 9th row. I'm using MS Word 2010.

    Set Rng = .Range(0, Tables(i).Range.Start)
    Please can you check this again for me. Thanks!

    .

    Wednesday, August 17, 2016 10:01 AM
  • Code revised. Try it now.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, August 17, 2016 12:42 PM
  • Thanks Paul,

    But again I got the same error on this line.

    Call ProcessRange(.Range(0, Tables(1).Range.Start))


    .

    Wednesday, August 17, 2016 12:50 PM
  • I am unable to reproduce that error regardless of whether the document has 0 or more tables, even if the first such table has no content before it or has 'around' wrapping.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, August 17, 2016 1:00 PM
  • Thanks Paul for your hard work.

    I just check it on Word 2016. It works well


    .

    Wednesday, August 17, 2016 1:08 PM
  • In your other thread (https://social.msdn.microsoft.com/Forums/office/en-US/61056df6-89e2-47da-85db-6c1c7aa48097/how-to-ignore-blank-paragraph-characters-when-running-the-macro?forum=worddev) you asked how to ignore empty paragraphs. I have again revised the code to handle that.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, August 17, 2016 8:39 PM
  • Hi Paul,

    Sorry for that.. In this thread I asking generally how to speedup macro by changing coding structure.

    In my another thread I'm asking about how to ignore blank paragraphs characters when searching the entire document.

    Same purpose but different macros and different ways. Please can you merge those two forum threads?

    Thanks!


    .

    Thursday, August 18, 2016 1:01 AM
  • I can't merge threads. However, the revised code above handles both scenarios.

    Cheers
    Paul Edstein
    [MS MVP - Word]

    Thursday, August 18, 2016 1:49 AM