VBA semi colon at end of sentences

Shelley Lou · #1 05-27-2021, 12:47 PM

Hi, I have got the macro below to insert semi-colons at the end of a sentence. I'm looking to exclude certain words at the end of sentence i.e 'and, but and or' as these belong to lists which already have a semi-colon before each of these words. How can I exclude these in the code. Thanks

Code:

Sub DPU_Test()
Application.ScreenUpdating = False
Dim Para As Paragraph
Dim oRng As Range
Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = ".^p"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    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
.Characters.Last.InsertBefore ";"
End If
End If
End With
Next
Application.ScreenUpdating = True

End Sub

Guessed · #2 05-27-2021, 10:56 PM

Try this

Code:

Sub DPU_Test2()
  'Application.ScreenUpdating = False
  Dim Para As Paragraph, oRng As Range
  Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = ".^p"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      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
          Select Case .Words.Last.Previous.Words(1)
            Case "and", "but", "or"
              'do nothing
            Case Else
              .Characters.Last.InsertBefore ";"
          End Select
        End If
      End If
    End With
  Next
  'Application.ScreenUpdating = True
End Sub

Shelley Lou · #3 05-27-2021, 11:53 PM

Many thanks Andrew for your kind assistance, this has worked perfectly and has saved me a lot of amending time with large documents, can't thank you enough.

Shelley Lou · #4 05-28-2021, 12:48 AM

Hi, I've inserted Andrew's updated macro for semi-colons into the macro below which works when run on its own. I've added it to the below macro, it runs with no errors but the insert semi-colon doesn't seem to be working within this macro. I've tried inserting it in various places but nothing seems to be working and I'm a bit stumped as to why. If anyone can help I would be most grateful. Thanks

Code:

Sub DPU_Definitions()
Dim oRng As Range
Dim Para As Paragraph
  Application.ScreenUpdating = False
   'Create placeholder.
  ActiveDocument.Range.InsertBefore vbCr
  ActiveDocument.Paragraphs(1).Range.Font.Bold = False
  'Convert numbers to text'
  ActiveDocument.Range.ListFormat.ConvertNumbersToText
  Set oRng = ActiveDocument.Range
  ResetFRParameters
   With oRng.Find
    'Remove colons'
    .Text = ":"
    .Font.Bold = True
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
  End With
   With oRng.Find
    'Remove colons'
    .Text = ":"""
    .Replacement.Text = """"
    .Execute Replace:=wdReplaceAll
  End With
    With oRng.Find
    'remove bold from spaces after the word means
    .Text = "means "
    .Replacement.Text = "means "
    .Replacement.Font.Bold = False
    .Execute Replace:=wdReplaceAll
  End With
   With oRng.Find
  'Delete white spaces before paragraph breaks
  .Text = "^w^p"
  .Replacement.Text = "^p"
  .Execute Replace:=wdReplaceAll
  End With
  With oRng.Find
  'Delete white spaces after paragraph breaks
  .Text = "^p^w"
  .Execute Replace:=wdReplaceAll
  End With
  Set oRng = ActiveDocument.Range
  With oRng.Find
  'Remove bold formatting from punctuation and para marks
    .Text = "[" & Chr(13) & ".;,:]"
    .MatchWildcards = True
    .Font.Bold = True
    .Replacement.Font.Bold = False
    .Execute Replace:=wdReplaceAll
  End With
    'Clear space before tabs
  With oRng.Find
    .Text = " ^t"
    .Replacement.Text = "^t"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  With oRng.Find
    'Remove double quotes'
    .Text = """"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
  End With
  Set oRng = ActiveDocument.Range
  'Replace tab with space'
  With oRng.Find
    .Text = "^t"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
  End With
  Set oRng = ActiveDocument.Range
  'Bold quotes
  With oRng.Find
    .Text = ""
    .Replacement.Text = "^034^&^034"
    .Font.Bold = True
    .Format = True
    .MatchWildcards = True
    While .Execute
      If Not InStr(oRng.Text, Chr(13)) Then
        While oRng.Characters.Last = Chr(32)
          oRng.Characters.Last.Font.Bold = False
          oRng.End = oRng.End - 1
        Wend
        oRng.Text = Chr(34) & oRng.Text & Chr(34)
        If oRng.Characters.First.Previous = Chr(13) Then
          oRng.Collapse wdCollapseEnd
          oRng.Font.Bold = False
          oRng.Characters.Last = vbTab
        Else
          oRng.Collapse wdCollapseEnd
        End If
      End If
    Wend
  End With
  ResetFRParameters
  Set oRng = ActiveDocument.Range
 'insert tab at beginning of paragraph with a bracket e.g. (a), (i), (1)
    With oRng.Find
        .MatchWildcards = True
        .Text = "^13(\([a-z0-9]{1,}\))"
        .Replacement.Text = "^p^t\1"
        .Execute Replace:=wdReplaceAll
    End With
    'insert tab at beginning of paragraph e.g a), 1), i), 100 etc.
    With oRng.Find
        .MatchWildcards = True
        .Text = "^13([a-z0-9\)]{1,})"
        .Replacement.Text = "^p^t\1"
        .Execute Replace:=wdReplaceAll
    End With
  'Remove the words means from each definition and insert a tab'
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "^tmeans"
    .Replacement.Text = "^t"
    .Execute Replace:=wdReplaceAll
  End With
  'Remove the words means and space before and insert a tab'
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = " ^tmeans"
    .Replacement.Text = "^t"
    .Execute Replace:=wdReplaceAll
  End With
  Set oRng = ActiveDocument.Range
 'Clears colons or commas after tabs.
  With oRng.Find
    .Text = "[^t]([:\,]){1,}"
    .Replacement.Text = "^t"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  'Clear space after tabs
  With oRng.Find
    .Text = "^t "
    .Replacement.Text = "^t"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  With oRng.Find
    'Remove colons'
    .Text = ":"""
    .Replacement.Text = """"
    .Execute Replace:=wdReplaceAll
  End With
  'Highligt tabs
  Set oRng = ActiveDocument.Range
   Options.DefaultHighlightColorIndex = wdYellow
  With oRng.Find
    .Text = "^t"
    .Replacement.Text = "^t"
    .Replacement.Highlight = True
    .Execute Replace:=wdReplaceAll
  End With
  ResetFRParameters
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "^t"
    Do While .Execute
      oRng.Start = oRng.Paragraphs(1).Range.Start
      If Len(.Text) - Len(Replace(.Text, vbTab, "")) > 1 Then oRng.Characters.Last.Text = " "
      oRng.Collapse wdCollapseEnd
    Loop
  End With
  'Insert semi-colon at end of sentences but not for and, but, or
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = ".^p"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      End With
  On Error Resume Next
  With Para.Range
      If Len(.Text) > 2 Then
        If Not .Characters.Last.Previous Like "[.!?:;]" Then
          Select Case .Words.Last.Previous.Words(1)
            Case "and", "but", "or"
              'do nothing
            Case Else
              .Characters.Last.InsertBefore ";"
          End Select
        End If
      End If
    End With
    'Remove placeholder.
  ActiveDocument.Paragraphs(1).Range.Delete
  Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = "^13[A-Za-z]"
    .MatchWildcards = True
    Do While .Execute
      If oRng.Paragraphs(2).Style = "Normal" And _
         oRng.Paragraphs(2).Range.Characters(1).Font.Bold = False Then
         oRng.Paragraphs(2).Range.InsertBefore vbTab
      End If
      oRng.Collapse 0
    Loop
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Set oRng = Nothing
  Exit Sub
End Sub

Code:

Sub ResetFRParameters()
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
lbl_Exit:
  Exit Sub

Guessed · #5 05-28-2021, 01:44 AM

You've gone straight to
With Para.Range

Without telling Word what Para is

Where is the loop
For Each Para In ActiveDocument.Paragraphs
...
Next Para

And get rid of the On Error Resume Next so it is easier to debug.

Shelley Lou · #6 05-28-2021, 02:35 AM

Thank you Andrew, not sure what happened there as I copied the code in your post as is, seems to be working ok now. Many thanks for your help

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Image semi-disappearing behind text lines	Ulodesk	Drawing and Graphics	3	01-28-2019 12:50 PM
Word is reverting my formatting semi-randomly after a third-party program removes sections	Alsadius	Word	4	11-27-2017 08:46 AM
Work semi completed	c991257	Project	11	05-11-2016 04:13 AM
aligning colon	JRaul	Word	4	07-07-2012 06:06 AM
Semi-flexible templates (couple of questions)	mshanks	Word	1	07-29-2009 06:35 AM