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