How do I delete any more than 1 specific character in a paragraph while leaving the first apperance? - vba

Question

Edit:
Spaces and tabs everywhere
Goal:
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.
Attempted Method:
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).
Issues:
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.
Description:
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.
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) <> "" 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 > 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 <= 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 >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

Answer 1

This code makes permanent changes to your data, so test it before using in real life.
This code seems to do what you want.
Sub TabFinder()
Dim i As Long
Const sFAKETAB As String = "|tab|"
For i = 1 To ThisDocument.Paragraphs.Count
'replace the first tab w a fake one
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, sFAKETAB, 1, 1)
'replace all other tabs w nothing
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, vbNullString)
'replace the fake tab w a real tab
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, sFAKETAB, vbTab)
Next i
End Sub
Here's the thing about using a For Each and changing the .Range.Text property: it doesn't work. It seems to reset which paragraph it's on. Kind of like when you delete something in a For Each loop and VBA loses track of where it is. So the above line are a little more verbose than 1) using For Each 2) using a With Block and/or 3) setting an object variable, but it works.
Update
Or you can replace the tabs with spaces, per Wayne's excellent comment.
Sub TabFinder3()
Dim i As Long
Dim j As Long
Const sFAKETAB As String = "|tab|"
Const lMAXTABS As Long = 5 'the maximum adjacent tabs you would have
For i = 1 To ThisDocument.Paragraphs.Count
'replace the first tab a fake one
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, vbTab, sFAKETAB, 1, 1)
'replace all other tabs w a space - multiple tabs replace wWith one space
For j = lMAXTABS To 1 Step -1
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, String(j, vbTab), Space(1))
Next j
'replace the fake tab w a real tab
ThisDocument.Paragraphs(i).Range.Text = Replace(ThisDocument.Paragraphs(i).Range.Text, sFAKETAB, vbTab)
Next i
End Sub

Answer 2

Let's try something like this which just uses some simple string functions.
First, iterate the paragraphs by index position (I couldn't make it work with a For Each oPara loop).
Capture each paragraph's text in a string variable: paraText
Use a Do ... Loop construct to replace the tabs with the string Replace function. The replacement text is assigned dynamically using the IIF function, which will use "^t" if TabCounter=1 or otherwise use the null string "". This loops until there are no tab characters in the string.
Once the paraText string has been thoroughly manipulated, simply assign that string to the oPara.Range.Text = paraText:
Option Explicit
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 TabsWantedPerLine As Long 'number of tabs we should keep in a line and not replace
Dim paraText As String 'represents the string of each paragraph
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 var = 1 To ActiveDocument.Paragraphs.Count 'for every paragraph in the document
Set oPara = ActiveDocument.Paragraphs(var)
TabCounter = 0
paraText = oPara.Range.Text
'# Loop until there are no more tabs left to replace
Do Until InStr(paraText, Chr(9)) = 0
TabCounter = TabCounter + 1
'# replace tabs in our temporary string variable:
paraText = Replace(paraText, Chr(9), IIf(TabCounter = 1, "^t", vbNullString), , 1)
Loop
'# Assign our new string ot the paragraph range
oPara.Range.Text = paraText
Next var
End Sub
Updated from comments above
Backwards iteration over each character in paragraph, delete character IF it's a tab AND there is another tab somwhere to the left of it within the paragraph. This is functionally same as ensuring there is only one tab per paragraph, and only the first one should remain.
Example document:
Example output:
Here is the updated code. This would need more (probably a lot more) tweaking if you wanted to allow more than one tab per paragraph, but since the limit is 1, I think this works.
Note: This does not address indentation which Word recognizes distinctly from the paragraph's text.
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 i As Integer
Dim paraText As String 'represents the string of each paragraph
Selection.HomeKey Unit:=wdStory 'go to the beginning of the document first for find feature
LeaveFirstTab = False
For var = 1 To ActiveDocument.Paragraphs.Count 'for every paragraph in the document
Set oPara = ActiveDocument.Paragraphs(var)
For i = oPara.Range.Characters.Count To 1 Step -1
If Mid(oPara.Range.Text, i, 1) = Chr(9) Then
'As long as there's another tab to the left of this one, delete this one
If InStr(Left(oPara.Range.Text, i - 1), Chr(9)) > 1 Then
oPara.Range.Characters(i).Delete
End If
End If
Next
Next
End Sub
Updated to explain Mid() Function
The VBA Mid function takes a substring of specified length, starting at a specified position, from a string. Syntax is:
MID( string, start_position, number_of_characters )
So in the code above, we are taking the substring beggining at i (our character iterator) with a length of 1. This is basic way to iterate over characters in a string.
I just noticed though that there is a better/simpler way to do this with Word's object model. Instead of the Mid function, I think you can use oPara.Range.Characters(i) to return the same substring. I don't know why I didn't realize this earlier because we actually use that method two lines later when we do the .Delete!
So modified:
For i = oPara.Range.Characters.Count To 1 Step -1
If oPara.Range.Characters(i) = Chr(9) Then
'As long as there's another tab to the left of this one, delete this one
If InStr(Left(oPara.Range.Text, i - 1), Chr(9)) > 1 Then
oPara.Range.Characters(i).Delete
End If
End If
Next