VBA Adding missing Punctuation to end of Paragraphs

Shelley Lou · #1 02-12-2024, 02:20 PM

I'm trying to write a macro which adds punctuation if it is missing. I want the macro to add a period to the end of all paragraphs that start with a Capital Letter or a semi colon if paragraphs start lowercase. These paragraphs may also contain a comment at the end.

If the lowercase paragraphs end with any of these words "and/or", "and", "but", "or" a semi-colon needs to be inserted before these words replacing any punctuation already there e.g. a comma.

I'm getting myself in a bit of a muddle with the Select Case and End Select throwing up errors and I can't work out why.

Would appreciate any advice on where I am going wrong. Thanks.

Punctuation.docx

Code:

Sub AddPuncDemo1()
Application.ScreenUpdating = False
Dim Para As Paragraph, oRng As Range
On Error Resume Next
For Each Para In ActiveDocument.Paragraphs
  With Para.Range
    If .Characters.Last.Previous.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then 'Not to include table of contents
    If Para.Range.Information(wdWithInTable) = False Then 'Not to include if in a table
            If Len(.text) > 2 And Not .Font.Bold And Not .Font.AllCaps Then 'Not to incude if para is bold or ALL UPPERCASE
          If Not .Characters.Last.Previous Like "[.!?:;]" Then 'If para ends with any of these characters do nothing
          Select Case .Words.Last.Previous.Words(1)
            Case "and/or", "and", "but", "or", "then", "plus", "minus", "less", "nor" 'If para ends with any of these words do nothing
            Case Else 'do nothing
          If .Characters(1).Case = wdUpperCase = True Then
          .Characters.Last.InsertBefore "." 'Insert period if para starts with capital letter
          If .Characters(1).Case = wdLowerCase = True Then
          .Characters.Last.InsertBefore ";" 'Insert semi colon if para starts lowercase
       
         Select Case .Words.Last.Previous.Words(1)
                    Case "and/or", "and", "but", "or", "then", "plus", "minus", "less", "nor"
                        Set oRng = .Words.Last.Previous.Words(1)
                        oRng.MoveStartWhile Chr(32), wdBackward
                        oRng.MoveStartWhile Chr(160), wdBackward
                        oRng.Start = oRng.Start - 1
                        If oRng.Characters(1) = ";" Then
                        'if semi-colon before case words do nothing else
                        End If
                        If oRng.Characters(1) = "," Then
                        'if have comma before case words convert comma to semi-colon
                        .Characters.Last.InsertBefore ";"
                        End If
                    Case Else
                End Select
            End If
      End If
      End If
      End If
      End If
      End If
  End With
Next
Application.ScreenUpdating = True
End Sub

Guessed · #2 02-12-2024, 07:14 PM

Give this a try

Code:

Sub AddPuncDemo2()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String
  'Application.ScreenUpdating = False
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      If .Information(wdInFieldResult) Or .Information(wdWithInTable) Or .Font.AllCaps Or .Font.Bold Or Len(.Text) < 3 Then
        GoTo NextFor
      Else
        Do While .Characters.Last.Previous = " "
          .Characters.Last.Previous.Delete
        Loop
        sFirstChar = .Characters(1)
        sLastWord = .Words.Last.Previous.Words(1)
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "then", "plus", "minus", "less", "nor"
              'do nothing
            Case Else
              If sFirstChar = UCase(sFirstChar) Then
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                .Characters.Last.InsertBefore ";" 'Insert semi colon if para starts lowercase
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub

Shelley Lou · #3 02-13-2024, 01:08 AM

Hi, thank you so much for replying with your code, its certainly a lot tidier than my effort. There is just something I still need to add which I tried to at the end of Demo1 - if there is punctuation other than a semi colon or no punctuation before the words "and" "or" "then" etc. then insert a semi colon before these words so they are "; and" instead of ", and" or " and". Would that be possible to include. Thank you.

Capture.JPG

Shelley Lou · #4 02-14-2024, 08:49 AM

Hi Andrew, so I've had a go at trying to update the code - the original code doesn't remove any spaces or non breaking spaces from the end of the paragraphs first, so when running the code its not inserting any punctuation at all - I've added some code to try and delete the space or non breaking space but I'm getting an error message at oRng.text = "" saying range cannot be deleted.

I'm also a bit stumped on how to change the comma or space before the string sLastWord to a semi colon - the string also needs to find instances of 'and/or' - in code terms would this be classed as 3 words or 6 characters?

If you could help at all I would be really grateful - thanks

Code:

Sub AddPuncDemo3()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String
  'Application.ScreenUpdating = False
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
    
    Set oRng = Para.Range
            oRng.End = oRng.End - 1
            oRng.Collapse 0
            oRng.MoveStartWhile Chr(32), wdBackward 'Space
            oRng.MoveStartWhile Chr(160), wdBackward 'Non breaking space
            oRng.text = "" 'ERROR SAYING RANGE CANNOT BE DELETED
      
      If .Information(wdInFieldResult) Or .Information(wdWithInTable) Or .Font.AllCaps Or .Font.Bold Or Len(.text) < 3 Then
        GoTo NextFor
      Else
        Do While .Characters.Last.Previous = " "
          .Characters.Last.Previous.Delete
        Loop
        sFirstChar = .Characters(1)
        sLastWord = .Words.Last.Previous.Words(1)
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;,]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "and/or", "then", "plus", "minus", "less", "nor"
            'do nothing
            
              'ADD IN HERE TO CHANGE COMMA OR SPACE BEFORE THESE WORDS TO SEMI COLON IF ONE IS NOT ALREADY THERE
              
          Set oRng = .Words.Last.Previous.Words(1)
                        oRng.MoveStartWhile Chr(32), wdBackward 'Space
                        oRng.MoveStartWhile Chr(160), wdBackward 'Non breaking space
                        oRng.Start = oRng.Start - 1
                        If oRng.Characters(1) = ";" Then
                        'do nothing
                        If oRng.Characters(1) = "," Or " " Then
                        'change comma to semi colon or add semi colon if space
                        .Characters.Last.InsertBefore ";"
              
            Case Else
              If sFirstChar = UCase(sFirstChar) Then
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                .Characters.Last.InsertBefore ";" 'Insert semi colon if para starts lowercase
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub

Guessed · #5 02-15-2024, 12:22 AM

OK, try this variation for those conditions

Code:

Sub AddPuncDemo3()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String
  'Application.ScreenUpdating = False
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Text = "^w^p"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      If .Information(wdInFieldResult) Or .Information(wdWithInTable) Or .Font.AllCaps Or .Font.Bold Or Len(.Text) < 3 Then
        GoTo NextFor
      Else
        sFirstChar = .Characters(1)
        sLastWord = .Words.Last.Previous.Words(1)
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "then", "plus", "minus", "less", "nor"
              Set oRng = .Words.Last    '.Previous.Words(1)
              oRng.MoveStartUntil cSet:=" ", Count:=-10
              Set oRng = oRng.Characters.First.Previous.Previous
              oRng.Select
              If oRng.Text = "," Then
                oRng.Text = ";"
              ElseIf oRng.Text Like "[a-z0-9]*" Then
                oRng.Collapse Direction:=wdCollapseEnd
                oRng.Text = ";"
              End If
            Case Else
              If sFirstChar = UCase(sFirstChar) Then
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                .Characters.Last.InsertBefore ";" 'Insert semi colon if para starts lowercase
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub

Shelley Lou · #6 02-15-2024, 11:08 AM

Hi Andrew, thank you so much for the updated code, it really is appreciated – I love how it whizzes through the document – I've run it several times on some large documents. There are just a couple of things the code isn't recognising:

If footnote references are at the end of the paragraph or if a text box field is before the words 'and', 'or' etc or if there is bold text within the paragraph - is this because at the beginning of the code its set to skip bold font? I added this in so that the code would skip bold headings rather than bold text within a paragraph.

Would it also be possible that if a paragraph ends with a semi-colon but the next paragraph starts with a Capital letter to make the semi-colon a period? I've added some images rather than upload a 70 page document.

Thank you so much for you help on this.

Pic1.JPG

Guessed · #7 02-15-2024, 03:55 PM

Yes, skipping bold does that. If the paragraph has some bold and some not then you could use the style names or test for bold on only the first character. I chose the latter in this code. To get the end of lists it would be more logical to test the outline levels of the paragraphs. I'm not sure what your 'text box fields' are but I've taken out the field test and perhaps that solves that issue.

Code:

Sub AddPuncDemo4()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String, bListEnd As Boolean
  'Application.ScreenUpdating = False
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Text = "^w^p"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      '.Select
      If .Information(wdWithInTable) Or .Font.AllCaps Or .Characters.First.Font.Bold Or Len(.Text) < 3 Then
        GoTo NextFor
      Else
        sFirstChar = .Characters(1)
        sLastWord = .Words.Last.Previous.Words(1)
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "then", "plus", "minus", "less", "nor"
              Set oRng = .Words.Last    '.Previous.Words(1)
              oRng.MoveStartUntil cSet:=" ", Count:=-10
              Set oRng = oRng.Characters.First.Previous.Previous
              oRng.Select
              If oRng.Text = "," Then
                oRng.Text = ";"
              ElseIf oRng.Text Like "[a-z0-9]*" Then
                oRng.Collapse Direction:=wdCollapseEnd
                oRng.Text = ";"
              End If
            Case Else
              If sFirstChar = UCase(sFirstChar) Then
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                If Para.Range.End < ActiveDocument.Range.End Then
                  bListEnd = Para.Range.ParagraphFormat.OutlineLevel > Para.Next.Range.ParagraphFormat.OutlineLevel
                  If bListEnd Then
                    .Characters.Last.InsertBefore "."                   'Insert period if stepping up levels
                  Else
                    .Characters.Last.InsertBefore ";"                   'Insert semi colon followed by same or lower level
                  End If
                Else
                  .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
                End If
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub

Shelley Lou · #8 02-16-2024, 07:56 AM

Hi Andrew, wow, this is incredible, I would never in a month of Sundays be able to create something like this, thank you so much.

Something I've noticed is if the paragraph starts with a character other than a letter e.g. a bracket, the code doesn't recognise that the first letter of the paragraph is actually lowercase and automatically inserts a period instead of a semi-colon.

Similarly, if there is e.g. a bracket before the sLastWords sting it doesn't recognise to add punctuation which could be why it is not recognising the square bracket also.

What would you suggest be added to solve this issue?

I've attached a really scaled down document so you can see what I mean at the highlighted paragraphs.

image 1.png

Test Punctuation 16.02.2024.docx

Guessed · #9 02-16-2024, 09:39 PM

Does these modifications deal with those edge cases?

Code:

Sub AddPuncDemo5()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String, bListEnd As Boolean
  'Application.ScreenUpdating = False
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Text = "^w^p"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      .Select
      If .Information(wdWithInTable) Or .Font.AllCaps Or .Characters.First.Font.Bold Or Len(.Text) < 3 Then
        GoTo NextFor
      Else
        sFirstChar = .Characters(1)
        If sFirstChar = "[" Or sFirstChar = "(" Then sFirstChar = .Characters(2)
        sLastWord = .Words.Last.Previous.Words(1)
        If sLastWord = "]" Or sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1)
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "then", "plus", "minus", "less", "nor"
              Set oRng = .Words.Last    '.Previous.Words(1)
              oRng.MoveStartUntil cSet:=" ", Count:=-10
              Set oRng = oRng.Characters.First.Previous.Previous
              oRng.Select
              If oRng.Text = "," Then
                oRng.Text = ";"
              ElseIf oRng.Text Like "[a-z0-9)]*" Or oRng.Text = "]" Then
                oRng.Collapse Direction:=wdCollapseEnd
                oRng.Text = ";"
              End If
            Case Else
              If sFirstChar = UCase(sFirstChar) Then
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                If Para.Range.End < ActiveDocument.Range.End Then
                  bListEnd = Para.Range.ParagraphFormat.OutlineLevel > Para.Next.Range.ParagraphFormat.OutlineLevel
                  If bListEnd Then
                    .Characters.Last.InsertBefore "."                   'Insert period if stepping up levels
                  Else
                    .Characters.Last.InsertBefore ";"                   'Insert semi colon followed by same or lower level
                  End If
                Else
                  .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
                End If
              End If
          End Select
        End If
      End If
    End With
NextFor:
  Next
  'Application.ScreenUpdating = True
End Sub

Shelley Lou · #10 02-18-2024, 04:45 AM

Hi Andrew, thank you so much for the updated code, I've been running it on several documents and all seems to be working well - something I didn't think to add is for the code to skip table of contents. I couldn't find a wd reference for table of contents so I added .Characters.Last.Previous.InRange(ActiveDocument.T ablesOfContents(1).Range) = False Then, it seems to work but would you have used different code?

I would like to add a message box at the end to say 'Complete' - I tried to insert MsgBox = "Complete" but it just made the message box continually appear when I pressed ok like it was on a continuous loop.

Guessed · #11 02-18-2024, 06:15 PM

I'm not convinced you actually need to skip the TOC, once the macro is run, just update the TOC to refresh it and undo anything the macro might have changed.

You did say that you run the macro multiple times across a document which doesn't make a great deal of sense. I would have thought it makes more sense to run it across a Selection (ie, you select the text you want the macro to work on before running the code). If that was the case, we change the initial scope to work on a selected range

Code:

For Each Para In ActiveDocument.Paragraphs

is changed to

Code:

For Each Para in Selection.Range.Paragraphs

Alternatively, you can get the macro to start working on the content in the file after the TOC (so you exclude any front matter, cover, toc etc from the paragraphs being processed.
eg change that same line to

Code:

  Dim rngSearch As Range
  Set rngSearch = ActiveDocument.Range(ActiveDocument.TablesOfContents(1).Range.End, ActiveDocument.Range.End)
  For Each Para In rngSearch.Paragraphs

Shelley Lou · #12 02-19-2024, 07:26 AM

Hi Andrew, thank you for your suggestions, I've tinkered about with both the On Selection method and the Auto .Select method – I think I prefer the Auto method, especially for small documents but may have to result to the On Selection for larger documents as these may contain Equations.

I've tested the code on a document that contained a TOC and it worked well, however, I then tested the code on a different document that did not contain a TOC but it threw up an Error 5941 'The requested member of the collection does not exist'. Could we get the code to look for TOC but if not present go to next as not all documents will contain a TOC.

Code:

Set rngSearch = ActiveDocument.Range(ActiveDocument.TablesOfContents(1).Range.End, ActiveDocument.Range.End)

Would it also be possible to get the code to look for punctuation already present before the last character, e.g. a square bracket or footnote etc. so that the code doesn't insert additional punctuation. I really appreciate the time you have taken to help me on this.

double punc image.JPG

Shelley Lou · #13 02-21-2024, 10:13 AM

Hi Andrew, I've just got one last thing I need to change so that the code runs correctly and then I can mark this post as complete. I've spent hours googling for the answer but I just can't find it.

The code needs to look to see if there is already punctuation before the last word/character e.g. square bracket and if there is go to next. I think I need to change this line:

Code:

If sLastWord = "]" Or sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1)

Code:

If sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1) 'Looks for punc after a bracket
If sLastWord = "]" Then sLastWord = .Words.Last.Previous.Previous.Words(1) 'Looks for punc before a square bracket

I've tried many different combinations of the .Words.Last.Previous.Previous.Words(1) but I just can't seem to get it to look before the last character.

I've added comments to the code so I can learn what each line does but there are a few I don't know.

Code:

Sub AddPuncDemo6()
  Dim Para As Paragraph, oRng As Range, sLastWord As String, sFirstChar As String, bListEnd As Boolean, i As Long, rngSearch As Range
  Dim Toc As Boolean
  'Application.ScreenUpdating = False
  With ActiveDocument.Range.Find
    .ClearFormatting
    .text = "^w^p" 'clears white space at end of paras
    .Replacement.text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
  For Each Para In ActiveDocument.Paragraphs
    With Para.Range
      .Select
      If .Information(wdWithInTable) Or .Font.AllCaps Or .Characters.First.Font.Bold Or Len(.text) < 3 Then 'WHAT DOES LEN(.TEXT) >3 MEAN?
        GoTo NextFor
      Else
        sFirstChar = .Characters(1) 'Look for first character at beginning of paras
        If sFirstChar = "[" Or sFirstChar = "(" Then sFirstChar = .Characters(2) 'Look for second character after bracket/square bracket at beginning of para
        sLastWord = .Words.Last.Previous.Words(1) 'Look for last character of para
        'If sLastWord = "]" Or sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1) 'If last character is a square bracket or bracket
        If sLastWord = ")" Then sLastWord = .Words.Last.Previous.Previous.Words(1) 'Looks for punc after a bracket
        If sLastWord = "]" Then sLastWord = .Words.Last.Previous.Previous.Words(1) 'Looks for punc before a square bracket
        Debug.Print sFirstChar, sLastWord
        If Not sLastWord Like "*[.!?:;,]" Then 'If para ends with any of these characters do nothing
          Select Case sLastWord
            Case "and", "but", "or", "then", "plus", "minus", "less", "nor" 'Sub paras ending with these words look for punc before them
              Set oRng = .Words.Last    '.Previous.Words(1)
              oRng.MoveStartUntil cSet:=" ", count:=-10 'If characters are less than 10
              Set oRng = oRng.Characters.First.Previous.Previous
              oRng.Select
              If oRng.text = "," Then 'Change comma before string words to semi-colon
                oRng.text = ";" 'Add semi-colon before string words
              ElseIf oRng.text Like "[a-z0-9)]*" Or oRng.text = "]" Then 'Look for paras ending with square bracket before string words
                oRng.Collapse Direction:=wdCollapseEnd
                oRng.text = ";" 'Add semi-colon
              End If
            Case Else
              If sFirstChar = UCase(sFirstChar) Then 'If first character is uppercase
                .Characters.Last.InsertBefore "." 'Insert period if para starts Uppercase
              Else
                If Para.Range.End < ActiveDocument.Range.End Then 'WHAT DOES THIS MEAN?
                  bListEnd = Para.Range.ParagraphFormat.OutlineLevel > Para.Next.Range.ParagraphFormat.OutlineLevel 'Looks for outline levels
                  If bListEnd Then
                    .Characters.Last.InsertBefore "."  'Insert period if stepping up levels
                  Else
                    .Characters.Last.InsertBefore ";"  'Insert semi colon followed by same or lower level
                  End If
                Else
                  .Characters.Last.InsertBefore "."    'Insert period if para starts Uppercase
                End If
              End If
          End Select
        End If
      End If
    End With
    
NextFor:
  Next
  'Application.ScreenUpdating = True
  MsgBox "Complete"
End Sub

Guessed · #14 03-02-2024, 09:56 PM

I haven't looked at this for a while but I think sometimes an edge-case like this can reach a point where the complexity to avoid it is more effort than just looking for instances AFTER the problem has been introduced.

What if you just run another find/replace after the main part of the macro has run to clear any unfortunate instances that you just introduced?

Shelley Lou · #15 03-04-2024, 09:17 AM

Hi Andrew, that is an excellent idea of looking for the duplication instances after the code has run. The below looks for instances of ;]; or .]. and removes the duplicate punctuation after the square bracket to be ;] or .] - this works well but only if the square bracket is not within a text form field. I'm not sure what to add to the code to look for if the square bracket is within a text form field.

Code:

Sub RemovePuncDemo1()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .text = "([;.])([\]])([;.])"
    .Replacement.text = "\1\2"
    .Execute Replace:=wdReplaceAll
    End With
End Sub

Capture.JPG

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA help with punctuation code	Shelley Lou	Word VBA	0	12-09-2022 05:39 AM
Adding punctuation to body of text	Sweetpea7	Word	5	08-29-2021 07:44 PM
punctuation order	fariz	Word	2	10-31-2016 12:57 AM
Punctuation	lexsper	Word	0	04-06-2015 07:26 AM
Paragraph border missing on interior paragraphs	strathglass	Word	1	09-19-2011 02:41 PM