View Single Post
 
Old 07-12-2018, 07:36 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,384
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You might try something along the lines of the following macro:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = ":[^s]{1,}"
      .Replacement.Text = ":^t"
      .Forward = True
      .Format = False
      .MatchWildcards = True
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
      .Wrap = wdFindStop
      .Text = "Command:*Help:*^13"
      .Execute
    End With
    Do While .Find.Found
      Set Rng = .Duplicate
      With .Duplicate
        With .Find
          .Forward = True
          .Format = False
          .MatchWildcards = True
          .Text = "[^13]{2,}"
          .Replacement.Text = "^p"
          .Execute Replace:=wdReplaceAll
          .Text = ":[^t ]@^13"
          .Replacement.Text = ":^t"
          .Execute Replace:=wdReplaceAll
          .Text = "^t*^13[!^t]@^13"
          .Execute
        End With
        Do While .Find.Found
          If Not .InRange(Rng) Then Exit Do
          With .Paragraphs.Last.Range
            .InsertBefore vbTab
          End With
          .End = .Paragraphs.Last.Range.Start
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
        With Rng
          With .Find
            .Forward = True
            .Format = False
            .MatchWildcards = True
            .Text = "^13^t"
            .Replacement.Text = "¶"
            .Execute Replace:=wdReplaceAll
          End With
          .ConvertToTable Separator:=vbTab, NumColumns:=2, AutoFitBehavior:=wdAutoFitContent
          .Tables(1).Style = "Table Grid"
          With .Find
            .Text = "¶"
            .Replacement.Text = "^p"
            .Execute Replace:=wdReplaceAll
          End With
        End With
      End With
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote