Microsoft Office Forums - View Single Post

Shelley Lou · 12-10-2020, 10:56 AM

So I've managed to sort some of the code regarding hyphens, brackets and ampersands. Still having an issue where a definition does appear in the unbold text and the macro converts it, is there a way to tell the macro to ignore these? I expect the macro could also be coded better as it does seem quite lengthy.

Code:

Sub DPU_convertdefinitions()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    ActiveDocument.Range.ListFormat.ConvertNumbersToText
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'replace tab with space'
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
  Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<*>"
        .Replacement.Text = "^034^&^034^t"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'tab after quote replace with space'
    With Selection.Find
        .Text = "^034^t ^034"
        .Replacement.Text = "^032"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove space after tab'
    With Selection.Find
        .Text = "^t "
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p("
        .Replacement.Text = "^p^t("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove the words means from each definition and insert a tab'
    With Selection.Find
        .Text = "^tmeans"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove colon after tab'
    With Selection.Find
        .Text = "^t:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove tab and quotes before hyphen'
    With Selection.Find
        .Text = "^034^t^045^034"
        .Replacement.Text = "-"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
     Selection.Find.Execute Replace:=wdReplaceAll
    'remove quote and tab before left bracket'
    With Selection.Find
        .Text = "^034^t^040^034"
        .Replacement.Text = " ("
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
     Selection.Find.Execute Replace:=wdReplaceAll
    'remove quote tab before right bracket'
    With Selection.Find
        .Text = "^034^t^041 ^034"
        .Replacement.Text = ") "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
      Selection.Find.Execute Replace:=wdReplaceAll
    'remove quote, tab and between ampersand'
    With Selection.Find
        .Text = "^034^t^038^034"
        .Replacement.Text = "&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove comma after tab'
    With Selection.Find
        .Text = "^t,"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
       .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'remove space after tab'
    With Selection.Find
        .Text = "^t "
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'replace periods with semi colons at end of each definition'
    With Selection.Find
        .Text = ".^p"
      .Replacement.Text = ";^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Dim oRng As Range
Const strText As String = "^13[A-Za-z]"
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(FindText:=strText, MatchWildcards:=True)
            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
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub