title: How do I delete any more than 1 specific character in a paragraph while leaving the first apperance?
body: <p>Edit: <img src="https://i.stack.imgur.com/4xAn3.jpg" alt="tabs eveywhere"></p>
  
  <p>Spaces and tabs everywhere</p>
  
  <p>Goal:</p>
  
  <p>If there's 1 tab or less, check the next paragraph.
  If there's 2 or more tabs, leave the first and delete the rest in that paragraph. Check next paragraph.
  I want to leave the first paragraph marker so I can turn it into a table with the word in the first column, and the description/definition in the second column.</p>
  
  <p>Attempted Method: </p>
  
  <p>Look at each character in a paragraph and count the tabs. After counting tab characters, if there are more than the desired amount (currently one tab) then replace the first tab in the paragraph with a "^t" (tab character) and then any remaining tabs in that paragraph with "" (nothing, essentially deleting it). </p>
  
  <p>Issues:</p>
  
  <p>The script only sometimes works. It seems to get hung up when there are lines with less than 2 tabs per line.
  The other times it'll delete the first tab in a line. The first occurrence should stay while the remainder leave.
  The last line of my test word document sometimes isn't touched.
  IF I run in repeatedly, it'll delete all tabs in the document except the last one in the last line.</p>
  
  <p>Description:</p>
  
  <p>I am an ugly coder, sorry. I'm self taught with loops, if/thens, and recording and modifying macros. This is not homework, it's so I don't have to manually go through 1,500 documents to format them since people use tabs to align text instead of the ruler bar. Pacman mode (show/hide non-printable characters mode) is very scary looking.</p>
  
  <pre><code>    Sub TabFinder()
  
  Dim oPara As Word.Paragraph 'paragraph
  Dim var 'a counter for a FOR loop for finding tabs in a paragraph, represents a single character
  Dim TabCounter As Long 'how many tabs will be in a paragraph
  Dim oChar As Word.Characters 'characters in a paragraph
  Dim StartHere As Long 'not currently used - thought I would try and save the location of the first tab to save it
  Dim TabsFoundAndReplaced As Long 'how many times the program has replaced a tab in a line
  Dim ReplaceText 'first tab will replace with a tab, 2nd and greater tab will be replaced with nothing
  Dim ReplaceAmmount As Long 'counter for how many times tabs have been replaced per line
  Dim TabsWantedPerLine As Long 'number of tabs we should keep in a line and not replace
  
  TabsWantedPerLine = 1 'desired upper limit of tabs to stay in a line
  
  Selection.HomeKey Unit:=wdStory 'go to the beginning of the document first for find feature
  
  For Each oPara In ActiveDocument.Paragraphs 'for every paragraph in the document
          TabCounter = 0
          Set oChar = oPara.Range.Characters 'find the number of characters, and set oChar as the total
              For var = 1 To oChar.Count 'for each character do the following
                  If oChar(var) &lt;&gt; "" Then 'stops an error
                      Select Case Asc(oChar(var)) 'stops an error
                          Case 9 '9 is tabs   'if there character oChar is a tab, then do the following
                              'If TabCounter = 0 Then StartHere = var 'not used currently, just a thought on how to save the tab with additional coding
                              TabCounter = TabCounter + 1 'counts tabs in the line
                      End Select
                  End If
              Next
              If TabCounter &gt; TabsWantedPerLine Then 'if there are more tabs in a paragraph than upper limit, do the following (hopefully deleting any after the desired tabs
                  For ReplaceAmmount = 1 To TabCounter 'do this for each of the tabs in the paragraph
                              If ReplaceAmmount &lt;= TabsWantedPerLine Then ReplaceText = "^t" Else ReplaceText = "" 'replaces the 
                              Selection.Find.ClearFormatting
                              Selection.Find.Replacement.ClearFormatting
                              With Selection.Find
                                  .Text = "^t"
                                  .Replacement.Text = ReplaceText 'replaces with a "^t" if first go around or "" if &gt;1st go around
                                  .Forward = True
                                  .Wrap = wdFindStop
                              End With
                              With Selection
                                  If .Find.Forward = True Then
                                      .Collapse Direction:=wdCollapseStart
                                  Else
                                      .Collapse Direction:=wdCollapseEnd
                                  End If
                                  .Find.Execute replace:=wdReplaceOne
                                  '.Find.Execute
                                  Set oChar = oPara.Range.Characters 'since we have replaced some characters in the paragraph
                              End With
                  Next ReplaceAmmount
              End If
  Next 'for each oPara
  
  End Sub
  </code></pre>