#1
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
#2
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
#4
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
#5
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
#7
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#8
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
#9
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#10
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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. |
#11
|
||||
|
||||
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 Code:
For Each Para in Selection.Range.Paragraphs 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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#12
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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) double punc image.JPG |
#13
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 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 |
#14
|
||||
|
||||
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?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#15
|
|||
|
|||
VBA Adding missing Punctuation to end of Paragraphs
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 |
|
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 |