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.

Code:

---

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

---

I suspect that what you require is

Code:

---

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

---

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.

If you have used heading styles then change

Code:

---

If Len(.Text) > 2 Then

---

to

Code:

---

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.

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.

Attachment 29127

You could include the code to remove end of paragraph spaces.
Replace

Code:

---

With oPara.Range
            If Len(.Text) > 2 And Not .Style Like "Heading*" Then

---

with

Code:

---

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

---

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.

Code:

---

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

Code:

---

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

---

Change the If statement

Code:

---

If Not .Characters.Last.Previous Like "[.!?:;]" Then
    .Words.Last.Previous.Words(1).HighlightColorIndex = wdPink
End If

---

to

Code:

---

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.

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

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.

Code:

---

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

---

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

Quote:

---

Originally Posted by Shelley_Lou

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