Macro to delete tabs in Word

Shelley Lou · #7 12-17-2020, 01:31 PM

Hi Macropod, I have inserted your macro into my macro but for some reason when running the code Word just freezes/crashes and I have go to Task Manager and End Task each time, do you know what this might be? I have attached a test document I've been running the code on if that helps.

definitions test 3.docx

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
     'find tab and highlight'
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "^t"
      .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertBefore vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "(^13[!^13]@^t[!^13]@)^t"
    .Replacement.Text = "\1 "
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
  End With
  Do While .Find.Execute = True
    .Find.Execute Replace:=wdReplaceAll
  Loop
  .Characters.First.Text = vbNullString
End With
Application.ScreenUpdating = True
    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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
I need a macro to format images and remove tabs. help	LuisXVI	Word VBA	4	11-12-2018 03:12 PM
Macro to delete pages in Word 2007	staicumihai	Word VBA	4	11-07-2018 01:14 AM
Need Word Macro to Delete Text	rsrasc	Word VBA	4	04-18-2018 11:32 PM
Tabs set along left edge of page; how to delete	ginny	Word	4	03-21-2018 08:07 PM
Word Macro to find and delete rows that contain adjacent cells containing "."	AlexanderJohnWilley	Word VBA	7	11-08-2012 10:15 AM