View Single Post
 
Old 05-28-2021, 12:48 AM
Shelley Lou Shelley Lou is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Dec 2020
Posts: 170
Shelley Lou is on a distinguished road
Default Updated VBA semi-colon at end of sentence

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
Reply With Quote