Solved: Find and Replace Only in Beginning of Pargraph (remove hard numbering)

[bstephens]

OK, here is the scenario. I typically get documents from outside sources that have what I call "hard numbering", meaning that "legal style numbering" is manually typed in, and tab characters (or space characters) are used to manually space the "hard numbered" document. (the numbering usually takes the following format 1.1, 1.1, 1.1.1, etc., with spaces and tabs all over the place)

I would like to be able remove the hard numbering at the beginning of each paragraph without removing any numbering which is cross-referenced in the document, so that I can apply auto numbering contained in my style set.

So for example, if an excerpt of the document looks like this:


1.11 Permitted Exceptions. Except as disclosed at 4.1, the permitted exceptions are as follows:
In the above example, I would like the macro to remove "1.11" (because it is at the beginning of the paragraph, but not "4.1" because it lies in the body of the paragraph. (I am not concerned with this macro removing tab characters or space characters, I already have separate macros to handle that, I would like this macro to only focus on removing hard numbering at the beginning of a paragraph. I'm also OK with the macro only handling "legal style" numbering)

I have the following code as a start:



Sub RemoveHardNumberingAll()
Call RemoveHardNumberingLevel3
Call RemoveHardNumberingLevel2
Call RemoveHardNumberingLevel1
End Sub

Sub RemoveHardNumberingLevel3()

Call MasterCleaner("^#^#.^#^#.^#^#", "") '11.11.11
Call MasterCleaner("^#^#.^#^#.^#", "") '11.11.1
Call MasterCleaner("^#^#.^#.^#^#", "") '11.1.11
Call MasterCleaner("^#^#.^#.^#", "") '11.1.1

Call MasterCleaner("^#.^#^#.^#^#", "") '1.11.11
Call MasterCleaner("^#.^#^#.^#", "") '1.11.1

Call MasterCleaner("^#.^#.^#^#", "") '1.1.11
Call MasterCleaner("^#.^#.^#", "") '1.1.1

Sub RemoveHardNumberingLevel2()

Call MasterCleaner("^#^#.^#^#", "") '11.11
Call MasterCleaner("^#^#.^#", "") '11.1

Call MasterCleaner("^#.^#^#", "") '1.11
Call MasterCleaner("^#.^#", "") '1.1

End Sub

Sub RemoveHardNumberingLevel1()
Call MasterCleaner("^#^#.", "") '11.
Call MasterCleaner("^#.", "") '1.
End Sub

Sub MasterCleaner(vFindText As String, vReplText As String)
If Documents.Count = 0 Then Exit Sub
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = vFindText
.Replacement.Text = vReplText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Does anyone know how to modify so that the function "RemoveHardNumberingAll" only gets rid of numbers at the beginning of a paragraph? Would also appreciate any input on modifications that could make this code more faster, shorter, and more efficient.

Appreciate any input on this.

Best,
Brian

[gmaxey]

Brian,

You and add a paragraph mark to your find and replacement strings. Like this:

("^13^#.^#^#^w", "^13")

This finds a paragraph mark preceding the number string and the white space following the numbers and replaces with a paragraph.

Of course this would not work for the first series of numbers in a document if there was no preceding paragraph mark.

You might also consider something more global:

Sub TryAll()
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(^13)([0-9]*{1,})([A-Z])"
.Replacement.Text = "\1\3"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub


This looks for a paragrah, then a line starting with a number, then everything up to the first capital A through Z and replaces with the paragraph and that first letter.

[gmaxey]

Brian,

You could also process selected (or all paragraphs) like this:

Sub ScratchMacro()
Dim i As Long
Dim oRng As Word.Range
Dim oParRng As Word.Range
Set oRng = Selection.Range
For i = 1 To oRng.Paragraphs.Count
Set oParRng = oRng.Paragraphs(i).Range
With oParRng
If .Characters.First Like "[0-9]" Then
.Collapse wdCollapseStart
.MoveEndUntil Cset:=" ", Count:=wdForward
.Delete
End If
End With
Next i
End Sub

[bstephens]

I changed oRng to "ActiveDocument" instead of "Selection" and this is exactly what I wanted! I will have to figure out to use "wildcards".

Sub RemoveAllSmart()
Dim i As Long
Dim oRng As Word.Range
Dim oParRng As Word.Range
Set oRng = ActiveDocument.Range
For i = 1 To oRng.Paragraphs.Count
Set oParRng = oRng.Paragraphs(i).Range
With oParRng
If .Characters.First Like "[0-9]" Then
.Collapse wdCollapseStart
.MoveEndUntil Cset:=" ", Count:=wdForward
.Delete
End If
End With
Next i
End Sub

Thanks

[bstephens]

Greg, did some more testing, do you know to revise this macro so that it will handle the case where there is numbering followed only by a "tab character"?

This line:

.MoveEndUntil Cset:=" ", Count:=wdForward

is causing the macro to remove the numbering and the first word of the paragraph in the case where there is hard numbering followed only by a tab symbol.

I have tried various revisions, including revisions like

.MoveStartUntil Cset:="[A-Za-z]", Count:=wdForward

but I cannot get it to work.

[bstephens]

OK, this solves the hard numbered "only followed by a tab" and not a space problem:

'Combination function to remove hard numbering
Sub RemoveHardNumberingAll()
Dim i As Long
Dim oRng As Word.Range
Dim oParRng As Word.Range
Set oRng = ActiveDocument.Range
For i = 1 To oRng.Paragraphs.Count
Set oParRng = oRng.Paragraphs(i).Range
With oParRng
If .Characters.First Like "[0-9]" Then
.Collapse wdCollapseStart
.MoveEndUntil Cset:="[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,A,B,C,D,E,F,G,H,I,J,K,L ,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z]", Count:=wdForward
.Delete
End If
End With
Next i
End Sub

I can't figure out why it doesn't work when I used "wild cards"...any suggestions to clean this up greatly appreciated.

Best,
Brian

[gmaxey]

Brian,

Wildcards aren't applicable in the case of range manipulation (only find and replace). Try this:

Sub RemoveHardNumberingAll()
Dim i As Long
Dim oRng As Word.Range
Dim oParRng As Word.Range
Dim char As Long
Set oRng = ActiveDocument.Range
For i = 1 To oRng.Paragraphs.Count
Set oParRng = oRng.Paragraphs(i).Range
With oParRng
If .Characters.First Like "[0-9]" Then
.Collapse wdCollapseStart
char = .MoveEndUntil(Cset:=vbTab, Count:=15) 'tab within 15 characters of first
If char > 1 Then
.MoveEnd wdCharacter, 1
.Delete
End If
End If
End With
Next i
End Sub