Search and replace tabulators of different length...?

macropod · #1 10-30-2012, 04:38 AM

I've tweaked the code for about as much performance as can be eked out of it:

Code:

Sub Demo()
Application.ScreenUpdating = True
Dim i As Long, j As Long, k As Long, l As Long, m As Long
Dim pRng As Paragraph, HPos As Single, StrStops As String
With ActiveDocument
  .DefaultTabStop = 0
  j = .Paragraphs(1).TabStops.Count
  For k = 1 To j
    StrStops = StrStops & "," & .Paragraphs(1).TabStops(k).Position
  Next
  l = .Paragraphs.Count
  With .Range.Duplicate
    For Each pRng In .Paragraphs
      i = i + 1
      Application.StatusBar = "Processing paragraph " & i & " of " & l
      With pRng.Range
        m = 0
        For k = 1 To j
          If .Characters.Last.Information(wdHorizontalPositionRelativeToTextBoundary) < _
            Split(StrStops, ",")(k) Then
            m = j - k
            Exit For
          End If
        Next
        Select Case m
          Case 1: .Characters.Last.InsertBefore vbTab
          Case 2: .Characters.Last.InsertBefore vbTab & vbTab
          Case 3: .Characters.Last.InsertBefore vbTab & vbTab & vbTab
          Case 4: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab
          Case 5: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab
          Case 6: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case 7: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case 8: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case 9: .Characters.Last.InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
        End Select
        m = Len(.Text) - Len(Replace(.Text, vbTab, ""))
        Select Case m
          Case j - 1: .InsertBefore vbTab
          Case j - 2: .InsertBefore vbTab & vbTab
          Case j - 3: .InsertBefore vbTab & vbTab & vbTab
          Case j - 4: .InsertBefore vbTab & vbTab & vbTab & vbTab
          Case j - 5: .InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab
          Case j - 6: .InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case j - 7: .InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case j - 8: .InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
          Case j - 9: .InsertBefore vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
        End Select
        If i Mod 10 = 0 Then
          DoEvents
          ActiveDocument.UndoClear
        End If
      End With
    Next
    .ParagraphFormat = .Paragraphs(1).Range.ParagraphFormat
  End With
End With
Application.StatusBar = "Done!!"
Application.ScreenUpdating = True
End Sub

We could also take out the progress report ... or make it update less often (eg in whole % iterations). The latter wouldn't be much faster, though and would update fairly infrequently.

Ultimately, you'd do far better getting whatever's generating the source file to put all the required tabs into the file at the outset.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Advanced search and replace for bullet points	TishyMouse	Word	5	02-17-2012 06:32 AM
Any wildcards search and replace in Powerpoint 2010?	tinfanide	PowerPoint	0	09-10-2011 02:17 AM
WORD: Rtf and search-replace (regexp/fonts)	seteshpl	Word	1	09-06-2011 01:35 AM
Search Replace Copy	dblack7211	Word	0	05-05-2010 01:19 PM
Search and Replace - Clear Search box	JostClan	Word	1	05-04-2010 08:46 PM