Word VBA help with missing punctuation macro

[Shelley_Lou]

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

[gmayor]

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

[Shelley_Lou]

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.

[gmayor]

If you have used heading styles then change

If Len(.Text) > 2 Then
to

If Len(.Text) > 2 And Not .Style Like "Heading*" ThenIf you have not used heading styles, you are just building in problems for the future. Use the replace function to add them as appropriate.

[Shelley_Lou]

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.

29127

[gmayor]

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

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

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

[Shelley_Lou]

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

[gmayor]

Change the If statement

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

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 SelectAs the table of contents paras will end in a number then this should address both issues.

[Shelley_Lou]

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

[Shelley_Lou]

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

[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

[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