Smart Auto Cross Referencer - Replace Hard Numbering with Cross Reference Entry

[bstephens]

I am trying to create a macro that will automatically add auto cross referenced entries (within paragraphs) to documents that have numbered items.

A specific illustration is helpful.

If my document contained legal numbering as follows:

1. This is a paragraph.
2. This is a paragraph.
2.1 This is a paragraph.
3. This is a paragraph.
4. This is a paragraph. This is a sentence referencing paragraph 2.1.
5. This is a paragraph.

and my selection in the document is the text "This is a sentence referencing paragraph 2.1." I would want my macro (despite the fact that the whole sentence is selected) to only replace the hard text "2.1" with a cross reference entry to the numbered item "2.1".

I have started with the following code (see below), but it is lacking.

I believe the key portion of the code "str(ExtractNumber(sel.Range, True)) = Left(Trim(v), 1)" is where I am going awry. I am having trouble getting this to evaluate to a true statement.

Specifically, with respect to "str(ExtractNumber(sel.Range, True))" the ExtractNumber function seems to extract decimal numbers from text (ex it will extract the "2.1") but I do not know how to make it extract "legal numbering", for example, if the the text was 2.1.1 it would not work.

With respect to "Trim(v)", I don't know how to extract just the numbered portion.

Would appreciate any guidance on this.

Best,
Brian

[vba]
Sub InsertAutoXRef()

Dim sel As Selection
Dim doc As Document
Dim vHeadings As Variant
Dim v As Variant
Dim i As Integer

Set sel = Selection
Set doc = Selection.Document

' Exit if selection includes multiple paragraphs
If sel.Range.Paragraphs.Count <> 1 Then Exit Sub

' Collapse selection if there are spaces or paragraph marks on either end
sel.MoveStartWhile cset:=(Chr$(32) & Chr$(13)), Count:=sel.Characters.Count
sel.MoveEndWhile cset:=(Chr$(32) & Chr$(13)), Count:=-sel.Characters.Count

vHeadings = doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
i = 1

For Each v In vHeadings
If str(ExtractNumber(sel.Range, True)) = Trim(v) Then
sel.InsertCrossReference _
referencetype:=wdRefTypeNumberedItem, _
referencekind:=wdNumberFullContext, _
referenceitem:=i
Exit Sub
End If
i = i + 1
Next v
MsgBox "Couldn't match: " & sel.Range.Text
End Sub

Function ExtractNumber(rCell As Range, _
Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double

Dim iCount As Integer, i As Integer, iLoop As Integer
Dim sText As String, strNeg As String, strDec As String
Dim lNum As String
Dim vVal, vVal2

''''''''''''''''''''''''''''''''''''''''''

'Extracts a number from a cell containing text and numbers.
'Please note this function is available at: http://www.ozgrid.com/VBA/ExtractNum.htm
'Thanks to the author
''''''''''''''''''''''''''''''''''''''''''
sText = rCell
If Take_decimal = True And Take_negative = True Then
strNeg = "-" 'Negative Sign MUST be before 1st number.
strDec = "."
ElseIf Take_decimal = True And Take_negative = False Then
strNeg = vbNullString
strDec = "."
ElseIf Take_decimal = False And Take_negative = True Then
strNeg = "-"
strDec = vbNullString
End If
iLoop = Len(sText)
For iCount = iLoop To 1 Step -1
vVal = Mid(sText, iCount, 1)
If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
i = i + 1
lNum = Mid(sText, iCount, 1) & lNum
If IsNumeric(lNum) Then
If CDbl(lNum) < 0 Then Exit For
Else
lNum = Replace(lNum, Left(lNum, 1), "", , 1)
End If
End If
If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
Next iCount
ExtractNumber = CDbl(lNum)
End Function
[/vba]

[Frosty]

I'm intrigued by this idea, but I think it's a lot more complicated than you've got at the moment. May I brainstorm with you for a moment? I'll assume you said yes...

How can you know some bit of text in your paragraph is a hard-coded xref? In the legal documents at my firm we use numbering schemes like...

Just the identification of xref patterns seems difficult, since "Section 2.1" "A.1" and "B.1(c)" could all be xref patterns. But so could "a" and "1" (which would typically be proceeded by something like "Paragraph" or "Section" etc... but you could also have "Paragraphs 1 and 2" and then you've just got a number hanging out).

So I'm not sure starting with the paragraph and looking for every possible alphanumerical pattern within it is the way to go.

What I would do, I *think* (and before I try this, I wanted to brainstorm with you and anyone else who joins in) that I would either
a) analyze likely patterns and only search for those. For me, this would generally mean I look to see what numbering is applied to my heading 1-9 styles (since the company I do most of my programming for uses this approach), and then I would search within my range for any patterns which match using (probably) a wildcard search.

b) force my end-user to actually select the text they want to replace with an auto-xref (much easier, and takes one of the most complex items out of this function).

After I have the pattern I want to replace with an automatic xref... then I have the problem of finding the right one. I think your approach there is probably a good one... cycle through the available xrefs array and insert.

What do you think?

[Frosty]

As an alternative, I'm wondering if the reason for this is because you hate the built-in xref dialog that Word provides. I hate it too. Mostly because it has two primary limitations: 1) after inserting a xref, it always jumps to the top of the list (which in long documents makes it almost unusable) and 2) it has no tree-view, so in long documents, inserting a xref to, say, Paragraph 18.21(a) and then subsequently inserting a xref to 18.21(b) involves a lot of scrolling.

So I've re-created it (somewhat) to allow a better user interaction-- after inserting a xref, it doesn't jump to the top of the list, and it allows expanding/contracting sub paragraphs in the same way that the document map does.

If this solution (not-automatic, but a better UI) is of interest to you-- let me know, I can probably work up a pretty quick demo and provide that.

[bstephens]

Hi Frosty, thanks for your input. I do loathe the built-in xref dialog that Word provides and would be interested in your solution that provides a more functional UI.

As far as the "automatic" macro, even if we could it to work using method "(b)" as referenced in your 09:48 message, that would be fantastic, and of course, much easier to accomplish than method "(a)", that method is making my head spin!

Having to select the actual text that the user desires to replace with a cross-reference is not too onerous (especially if the macro is assigned to a hot-key).

Would be interested in exploring method (b) more. I've been trying different methods to get the critical statement to evaluate to true. I believe part of my problem is type mismatch, I am not sure if I should be comparing, numbers, variants, or strings on both sides of "str(ExtractNumber(sel.Range, True)) = Left(Trim(v), 1)".

Best,
Brian

[Frosty]

Brian,

See what you think of this...

[bstephens]

Frosty, the UI you posted is fantastic! Much, much better UI if you have alot of cross-ref work to do

I'm going to continue to look into an automatic solution that will replace hard text with cross references in some limited cases (particularly legal numbering).

For example:

1.
11.

1.1
1.11
11.1
11.11

1.1.1
...
11.11.11
etc..

[Frosty]

I'll look at that too. The UI has always been a bit of a work in progress, because I only replaced the specific functionality my users generally worked with, but it's been received pretty well in my environment.

Glad it is of some use to you

[Frosty]

Brian,

This is just a proof of concept, but this seems to work (and it doesn't even require selecting the text).

EDIT: solved my 1.1. vs. 1.1 problem. Try this out with your cursor in a paragraph which contains a non-auto xref.
[vba]
'----------------------------------------------------------------------------------------------
' automatically insert any xrefs into the passed range
'----------------------------------------------------------------------------------------------
Public Sub AutoXRefDemo(Optional rngWorking As Range)
Dim aryXrefs() As String
Dim aryXRefNumbers() As String
Dim i As Integer
Dim sRet As String
Dim rngSearch As Range
Dim iXRefToInsert As Integer
Dim sXRef As String

'get our array of xref items
aryXrefs = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

'build our array of items to search for
ReDim aryXRefNumbers(UBound(aryXrefs))
For i = 1 To UBound(aryXrefs)
sRet = Trim(aryXrefs(i))
sRet = Trim(Left(sRet, InStr(sRet, " ")))
aryXRefNumbers(i) = sRet
Next

'check our range, just set to the paragraph the cursor is in, if we didn't pass anything
If rngWorking Is Nothing Then
Set rngWorking = Selection.Paragraphs(1).Range
End If
'search through our paragraph for any matches
For i = 1 To UBound(aryXRefNumbers)
Set rngSearch = rngWorking.Duplicate
sXRef = aryXRefNumbers(i)
'remove the trailing character, if it's not meaningful
Select Case Right(sXRef, 1)
Case ".", ")"
sXRef = Left(sXRef, Len(sXRef) - 1)
Case Else
End Select

'make sure it's surrounded by spaces
If rngSearch.Find.Execute(" " & sXRef & " ") Then
rngSearch.MoveStart wdCharacter, 1
rngSearch.MoveEnd wdCharacter, -1
'this is just here for the proof of concept
rngSearch.Select
iXRefToInsert = i
Exit For
End If
Next
'now that we have our range... insert appropriate xref
rngSearch.InsertCrossReference wdRefTypeNumberedItem, wdNumberFullContext, iXRefToInsert
End Sub
[/vba]

[Frosty]

This is just a proof of concept... the real deal would need to be a lot more robust, but this approach works. I would just separate out the functionality into multiple routines, to allow future flexibility (end-users would experience running this code on Section 1.1 and end up with either 1.1 1.1 or Section Section 1.1 -- I haven't tested that scenario yet).

[bstephens]

Frosty, been testing the code. For some reason my system is having trouble running the version as sent which has the optional argument. When I try and run it from the VBA editor it just brings up the "macro" window with a list of all the macros and does not run the code.

However, I restated the sub a little as follows (taking out the optional argument):

[VBA]
Public Sub AutoCrossReferencer()
Dim aryXrefs() As String
Dim aryXRefNumbers() As String
Dim i As Integer
Dim sRet As String
Dim rngSearch As Range
Dim iXRefToInsert As Integer
Dim sXRef As String
Dim rngWorking As Range 'dimension the range


Set rngWorking = Selection.Range 'set the initial range to the current selection

'get our array of xref items
aryXrefs = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem)

'build our array of items to search for
ReDim aryXRefNumbers(UBound(aryXrefs))
For i = 1 To UBound(aryXrefs)
sRet = Trim(aryXrefs(i))
sRet = Trim(Left(sRet, InStr(sRet, " ")))
aryXRefNumbers(i) = sRet
Next


For i = 1 To UBound(aryXRefNumbers)
Set rngSearch = rngWorking.Duplicate
sXRef = aryXRefNumbers(i)
'remove the trailing character, if it's not meaningful
Select Case Right(sXRef, 1)
Case ".", ")"
sXRef = Left(sXRef, Len(sXRef) - 1)
Case Else
End Select

'make sure it's surrounded by spaces
If rngSearch.Find.Execute(" " & sXRef & " ") Then
rngSearch.MoveStart wdCharacter, 1
rngSearch.MoveEnd wdCharacter, -1
'this is just here for the proof of concept
rngSearch.Select
iXRefToInsert = i
Exit For
End If
Next
'now that we have our range... insert appropriate xref
rngSearch.InsertCrossReference wdRefTypeNumberedItem, wdNumberFullContext, iXRefToInsert
End Sub

[/VBA]

and it seems to be working great! Probably needs some error trapping or MsgBox's or something to make it a little more user friendly, but I'm really liking it!

Any idea why it won't run on my system when it has the optional argument?

I am using Word 2010 (32-bit) on 64-bit windows 7, English language for everything. I have changed nothing in the environment from the default settings (i.e., add-ins, object libraries, etc.).

[Frosty]

You can run macros with optional parameters using F5. You can, however, call them from other procedures or the immediate window. That's often how I test. The reason for the optional parameter is to allow you to run it in standalone or by passing in a defined range from another macro, rather than having to use the selection.range all the time (which can be limiting, or worse, start changing text you don't want to change into xrefs when it's in the middle of xrefs you do want to change)

It's just a technique... If it's not something you want to utilize, there's no harm in not utilizing it.

[Frosty]

Gah... You canNOT run macros with optional parameters using F5

[Frosty]

Brian,

Just to clarify one of my points... I use optional parameters so that I can test various ways of using the code from the immediate window. So with the optional parameters, I might do all of the following lines of calling that code from the immediate window:
AutoXRefDemo Selection.Range
AutoXRefDemo ActiveDocument.Paragraphs(4).Range
etc
And then when I want to add it as a button... I will construct the following subroutine:
[VBA]
Sub UI_AutoXRef
AutoXRefDemo Selection.Range
End Sub
[/VBA]
And then UI_AutoXRef would be the routine I call from either the Macros menu or a button. It seems a little convoluted, but it's become my habit... mostly because when I find a function which is useful, it's often useful as more than just a single button-- it might be useful in the context of a larger routine (such as, paste special > unformatted text, reapply auto-numbering, reapply xrefs in the text I just pasted).

Again, it's just a technique/habit which may be of marginal usefulness (and extra convolution) which is not good for you. I often forget how many people don't use the immediate window at all in their regular coding... whereas for me it is where I do half of my code.