Consulting

Results 1 to 12 of 12

Thread: Word VBA help with missing punctuation macro

  1. #1

    Word VBA help with missing punctuation macro

    Hi this is my first time posting to this forum so hope I'm doing this correctly. I have a macro that highlights where punctuation is missing at the end of paragraphs:

    1. It doesn't work if the paragraph ends in a cross reference field.
    2. If sublevel paragraphs end with a comma before "and", "but", "or", "then" to also be highlighted pink BUT the sublevels end with a semi-colon before "and", "but", "or", "then" then these paragraphs should not be highlighted as the correct punctuation is in place.

    Can anyone please help me fine tune the code below. Much appreciated.

    Sub DPU_HighlightMissingPunctuation()Application.ScreenUpdating = False
      Dim Para As Paragraph, oRng As Range
      Set oRng = ActiveDocument.Range
        With oRng.Find
          .Text = "([!^13.,:;\?\-\!]^13)" 'Looks for missing punctuation at end of paragraphs
          .Font.Bold = False
          .Replacement.Highlight = wdPink 'and highlight last character as pink
          .Execute Replace:=wdReplaceAll    'BUT DOESN'T WORK IF LAST CHARACTER IS A FIELD
          End With
      On Error Resume Next
      For Each Para In ActiveDocument.Paragraphs
        With Para.Range
          If Len(.Text) > 2 Then
            If Not .Characters.Last.Previous Like "[.!?:;]" Then 'if para ends with punctuation do not highlight
              Select Case .Words.Last.Previous.Words(1)
                Case "and", "but", "or", "then" 'if para ends with these words and have semi-colon before them do nothing no highlight else
                .HighlightColorIndex = wdNoHighlight
                  'do nothing
                Case Else
                Case "and", "but", "or", "then" 'if para ends with these words and have a comma before them highlight pink
                  .Characters.Last.InsertBefore ","
                  .HighlightColorIndex = wdPink
              End Select
            End If
          End If
        End With
      Next
      Application.ScreenUpdating = True
    End Sub

  2. #2
    I suspect that what you require is
    Sub DPU_HighlightMissingPunctuation()
    'Graham Mayor - https://www.gmayor.com - Last updated - 02 Nov 2021 
    Dim oPara As Paragraph
    Dim oRng As Range
        Application.ScreenUpdating = False
        On Error Resume Next
        For Each oPara In ActiveDocument.Paragraphs
            With oPara.Range
                If Len(.Text) > 2 Then
                    If Not .Characters.Last.Previous Like "[.!?:;]" Then
                        .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
                    End If
                    Select Case .Words.Last.Previous.Words(1)
                        Case "and", "but", "or", "then"
                            Set oRng = .Words.Last.Previous.Words(1)
                            oRng.MoveStartWhile Chr(32), wdBackward
                            oRng.Start = oRng.Start - 1
                            If oRng.Characters(1) = ";" Then
                                'if oPara ends with these words and have semi-colon before them do nothing no highlight else
                                .Words.Last.Previous.Words(1).HighlightColorIndex = wdNoHighlight
                            End If
                            If oRng.Characters(1) = "," Then
                                'if oPara ends with these words and have comma before them do nothing no highlight else
                                .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
                            End If
                        Case Else
                    End Select
                End If
            End With
        Next oPara
        Application.ScreenUpdating = True
    lbl_Exit:
        Set oPara = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Hi Graham, thank you so much for the amended code, I've been going round in circles trying to work it out. What can I add so it doesn't pick up any bold headings as these never have punctuation so doesn't need to be highlighted. Again, thank you for taking the time to help me.

  4. #4
    If you have used heading styles then change
    If Len(.Text) > 2 Then
    to
    If Len(.Text) > 2 And Not .Style Like "Heading*" Then
    If you have not used heading styles, you are just building in problems for the future. Use the replace function to add them as appropriate.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Hi Graham, thank you for the reply very much appreciated. The documents are indeed set up using Heading 1 to 7 for the main body of the document, Heading 1 being the main clause bold heading, heading 2 can either be plain or the style Heading 2(Title) which is bold. Heading 3 might also be manually made bold in parts of the document and of course there will be schedule headings to consider that may be numbered/not numbered. I have attached an image as an example. I've added the extra bit to the code as you have suggested but maybe it should just ignore bold altogether. I've run the code on a couple of documents, if there is e.g. a full stop, followed by space, then paragraph mark, it seems to recognise this para as having no punctuation, I did a find and replace to remove the spaces and the code worked as it should.

    highlight image.jpg
    Attached Images Attached Images

  6. #6
    You could include the code to remove end of paragraph spaces.
    Replace
    With oPara.Range
                If Len(.Text) > 2 And Not .Style Like "Heading*" Then
    with
    With oPara.Range
                Set oRng = oPara.Range
                oRng.End = oRng.End - 1
                oRng.Collapse 0
                oRng.MoveStartWhile Chr(32), wdBackward
                oRng.Text = ""
                If Len(.Text) > 2 And Not .Style Like "Heading*" Then
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Hi Graham, thank you very much for the extra code, it is very much appreciated. I have added And Not .Font.Bold to the below code which seems to have sorted some of the bold being highlighted issues.
    If Len(.Text) > 2 And Not .Style Like "Heading*" And Not .Font.Bold Then
    I'm just doing my first house style document of the day and have run the code, looks like this is going to be an ongoing project as it needs to ignore table of contents, if para ends with footnote reference or square bracket and maybe not to include tables at all..

    How do you tell code to read a square bracket as a square bracket so I can add it to this line of code

    If Not .Characters.Last.Previous Like "[.!?:;]" Then

  8. #8
    Change the If statement
    If Not .Characters.Last.Previous Like "[.!?:;]" Then
        .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
    End If
    to
    Select Case .Characters.Last.Previous
        Case ".", "!", "?", ":", ";", "[", "]", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
        Case Else
              .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
    End Select
    As the table of contents paras will end in a number then this should address both issues.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Thank you Graham, I will add this to the code, much appreciated

  10. #10
    Hi, I have been working with the code below (created by Graham M) on legal documents for a while now but today have come across an issue - if there are comments within the document that appear in a window to the right, the code crashes Word - I've tested the same document without the comments and it works just fine - what could I add to the code to deal with comments - also by way of interest, the code highlights the whole word where punctuation is missing but I would like it to only highlight the last letter if possible.

    Sub HighlightMissingPunctuation()Dim oPara As Paragraph
    Dim oRng As Range
        Application.ScreenUpdating = False
        On Error Resume Next
        For Each oPara In ActiveDocument.Paragraphs
            With oPara.Range
                Set oRng = oPara.Range
                oRng.End = oRng.End - 1
                oRng.Collapse 0
                oRng.MoveStartWhile Chr(32), wdBackward
                oRng.text = ""
                If .Characters.Last.Previous.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then
                If oPara.Range.Information(wdWithInTable) = False Then
                If Len(.text) > 2 And Not .Font.Bold And Not .Font.AllCaps Then
                    If Not .Characters.Last.Previous Like "[.!?:;,]" Then
                        .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
                    End If
                    End If
                    End If
                    Select Case .Words.Last.Previous.Words(1)
                        Case "and", "but", "or", "then", "and/or"
                            Set oRng = .Words.Last.Previous.Words(1)
                            oRng.MoveStartWhile Chr(32), wdBackward
                            oRng.Start = oRng.Start - 1
                            If oRng.Characters(1) = ";" Then
                                'if oPara ends with these words and have semi-colon before them do nothing no highlight else
                                .Words.Last.Previous.Words(1).HighlightColorIndex = wdNoHighlight
                            End If
                            If oRng.Characters(1) = "," Then
                                'if oPara ends with these words and have comma before them highlight pink
                                .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
                            End If
                        Case Else
                    End Select
                End If
            End With
        Next oPara
        Application.ScreenUpdating = True
    lbl_Exit:
        Set oPara = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub

  11. #11

    VBA help with punctuation macro

    The issue seems to be when the comment is at the end of the paragraph where punctuation is missing and this is what is crashing the code - how can I tell the code to skip comments? I've added a test document so you can see. Thanks
    Attached Files Attached Files

  12. #12
    Quote Originally Posted by Shelley_Lou View Post
    The issue seems to be when the comment is at the end of the paragraph where punctuation is missing and this is what is crashing the code - how can I tell the code to skip comments? I've added a test document so you can see. Thanks
    Is anyone able to help with this issue?
    Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •