Tracked Changes causing issues with custom user form to Insert Cross-References

Hi experts

I have a vba userform with a list box and a couple of buttons to insert cross-references.

On initialising the form, the list box is populated with the following code.
       
        Me.ListBox1.Clear
        myCR = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
    
        For i5 = 1 To UBound(myCR)
        Me.ListBox1.AddItem myCR(i5)
        Next i5

Open in new window


And then I have a button to insert the cross-reference with heading and paragraph number.

Private Sub CommandButton3_Click()
  
    On Error GoTo NoRef_Error_Click
    
    Dim RefType, RefKind As String
    Dim n As Long
    n = Me.ListBox1.ListIndex + 1
    
    If Me.OptionButtonHeadings = True Then
        RefType = wdRefTypeHeading
        RefKind = wdNumberRelativeContext
        

    
    End If
 
 
    'heading number or caption number insertion
    Selection.InsertCrossReference ReferenceType:=RefType, ReferenceKind:= _
            RefKind, referenceItem:=n, InsertAsHyperlink:=True, _
            IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
        
        
     'Headings only - check number is not "0" and then add the heading text
     If Me.OptionButtonHeadings = True Then
     
            Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
            
            If Selection.Range = "0" Then
                Selection.Delete
                Selection.TypeBackspace
            Else
                Selection.MoveRight unit:=wdWord, Count:=1
            End If
            
            Selection.TypeText " "
            
            Selection.InsertCrossReference ReferenceType:=(wdRefTypeHeading), ReferenceKind:= _
            wdContentText, referenceItem:=n, InsertAsHyperlink:=True, _
                    IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    
    
    Else     'insert caption text for figure/Photos/tables
    
        Selection.TypeText " "
         
            Selection.InsertCrossReference ReferenceType:=RefType, ReferenceKind:=wdOnlyCaptionText, _
    referenceItem:=n, InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    
    End If
   
    Unload Me
    
    ActiveDocument.Fields.Update
    
    Exit Sub
NoRef_Error_Click:
    MsgBox "Please select a valid item to reference."
    Exit Sub
End Sub

Open in new window


That has worked fine until someone was using tracked changes. I've discovered if the first word of the paragraph has been deleted and replaced with other text, that cross reference won't show up in my UserForm. HOWEVER, when I select a paragraph after that one in my list box, it causes the incorrect cross reference to be inserted.

For instance, my document contains the headings

1. Hello there
2. A big hello there
3. An even bigger hello there

Someone has used tracked changes and deleted the word "Hello" from paragraph 1 and replaced it with "Hi". When I generate the user form, the list box does not show the Heading "1. Hi there". I select "2. A big hello there" from the list box and press the button to insert the cross reference and I end up with "1. Hi there" in my document, not "2. A big hello there".

I understand track changes is interfering with it and causing the indexing to be out. However if I were to use Word's own in-built dialog box to insert the cross reference to "2. A big hello there" - it would be correct.

I don't know how to resolve the problem?

Should I try and loop through all headings in the document and accept all track change deletions in headings?

Should I try and pick up Word's own in-built dialog box - not sure how I would do that though.

I have attached a document with problematic track changes in the headings to show you what I mean if you want to create a userform with a list box and a command button and test the issue.

Please help.
testing-cr2.docx
Fi69Asked:
Who is Participating?
 
DrTribosConnect With a Mentor Commented:
It would be quick if you use find replace all. Run your macro. Then reverse the find replace.
I think ^13 is the paragraph marker ... replacing the paragraph marker with a paragraph marker and a space put a space in front of the next paragraph which should solve the issue except for the first paragraph
0
 
DrTribosCommented:
I confess to not quite understanding your question but I think I have the gist of it.  

Word uses hidden bookmarks for cross references, they have a "_" in front of them to hide them in the document, i.e.  prevent the " [ " & " ] "   markers from showing.

You can view hidden bookmarks by pressing Alt > I > K then check the show hidden box, they will appear in a list.  Then use the goto button to find their location.

It might be the case that the user has accidentally deleted a bookmark?

Also, tracked changes and I have never gotton along - do some counts on the number of headings that word reports compared to what you expect to see...

If possible, can you upload a document / template that has the code & userform in it as well?

Hopes this gets you started :-)
0
 
Fi69Author Commented:
Hi Dr Tribos

No the problem is that the heading doesn't show in the List Box, for some reason it gets skipped because of the tracked changes (it seems to happen if the first word in the paragraph is deleted via tracked changes - if it was the second, third,fourth word in the paragraph it wouldn't be a problem). So when the user selects the item they want in the list box, it is essentially returning the wrong index number because when the cross reference is made in the document, the other headings are actually there.

Link to testing file can be found here.
https://www.dropbox.com/s/6op1s4okcfpnm76/testing%20cr.docm
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
DrTribosCommented:
So... I count 6 headings in the document and they all show up in the list box... :-/

See image, not sure if I am missing something...
EE-ID28417432.jpg
0
 
Fi69Author Commented:
That's weird. You didn't remove the track changes did you?

When I do it, I get the following (so does my client).
cr-pic.jpg
0
 
DrTribosCommented:
I am using Word 2010, are you in 2007?
0
 
DrTribosCommented:
BTW, no - I did not change any settings.  I tried different views (original & final w markup) but no change.
0
 
Fi69Author Commented:
Nope, I'm in 2010 also.
0
 
Fi69Author Commented:
And I've tried different settings too, but get the same each time.
0
 
DrTribosCommented:
Ok... sanity check - close word and try downloading your own document from EE
0
 
Fi69Author Commented:
I think I have the most up to date version. I can't see that there are any updates to install. Pic of my version details.
version-info.jpg
0
 
Fi69Author Commented:
Sanity checked passed - behaving exactly the same when downloaded from above link. BTW, my previous comment was on the Word version I'm using.
0
 
DrTribosCommented:
I can confirm that our versions are exactly the same
0
 
Fi69Author Commented:
So in your document, can you see the following tracked changes?

tracked changes
0
 
DrTribosCommented:
My bad - I downloaded again and yes... I only see 4 headings now... I think I unwittingly bumped the F5 with cursor on one of your macros...

Revision control to be precise...
0
 
Fi69Author Commented:
LOL. That's okay. I've got some code in there where I was testing trying to cycle through all tracked changes and accept any deletions inside a heading, but in a long document I have at this end it errors out, so not sure about that approach.

How did you count the headings in the document, is there a simple line of code for that?
0
 
GrahamSkanRetiredCommented:
Hi Fi,

I was having trouble with your code, and had to change a couple of things to get it working at all:
Option Explicit

Private Sub CommandButton3_Click()
  
    'On Error GoTo NoRef_Error_Click
    'removed on error so that error is raised immediately GLS
    
    Dim RefType As WdReferenceType, RefKind As WdReferenceKind 'change variable types
                                                              ' to avoid Type Mismatch error GLS 
                               
    Dim n As Long
    n = Me.ListBox1.ListIndex + 1
    
    If Me.OptionButtonHeadings = True Then
        RefType = wdRefTypeHeading
        RefKind = wdNumberRelativeContext
    End If
 
    'heading number or caption number insertion
    Selection.InsertCrossReference ReferenceType:=RefType, ReferenceKind:= _
            RefKind, referenceItem:=n, InsertAsHyperlink:=True ', _
            'IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
               'optional parameters omitted to avoid Command Failed error GLS 
               
     'Headings only - check number is not "0" and then add the heading text
     If Me.OptionButtonHeadings = True Then
            Selection.MoveLeft unit:=wdWord, Count:=1, Extend:=wdExtend
            If Selection.Range = "0" Then
                Selection.Delete
                Selection.TypeBackspace
            Else
                Selection.MoveRight unit:=wdWord, Count:=1
            End If
            
            Selection.TypeText " "
            
            Selection.InsertCrossReference ReferenceType:=(wdRefTypeHeading), ReferenceKind:= _
            wdContentText, referenceItem:=n, InsertAsHyperlink:=True, _
                    IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    
    Else     'insert caption text for figure/Photos/tables
    
        Selection.TypeText " "
         
            Selection.InsertCrossReference ReferenceType:=RefType, ReferenceKind:=wdOnlyCaptionText, _
    referenceItem:=n, InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    End If
    Unload Me
    ActiveDocument.Fields.Update
    Exit Sub
NoRef_Error_Click:
    MsgBox "Please select a valid item to reference."
    Exit Sub
End Sub
                                  


Private Sub UserForm_Initialize()
Dim i5 As Integer
Dim myCR() As String
Me.ListBox1.Clear
        myCR = ActiveDocument.GetCrossReferenceItems(wdRefTypeNumberedItem) 'wdRefTypeHeading)
    
        For i5 = 1 To UBound(myCR)
        Me.ListBox1.AddItem myCR(i5)
        Next i5
End Sub

Open in new window


Certainly the reference for the first paragraph cannot be found by any method that I have tried, so I can only assume that it has gone. However I cannot replicate the action by deleting the first word of the other paragraphs while tracking is enabled. I am using Word 2007.

I am confused about what you are actually wanting to achieve. You seem to be trying to find existing cross-reference targets and to set another reference to the same target. Is that correct?

(Steve should be in bed now building up his stamina for the upcoming ceremony.)
0
 
DrTribosCommented:
Hi Graham - you were probably right, should be in bed! Right now trying to stay warm - I have minor cold threatening to develop  :-/

Fi - I will have to bow out of this (stuff to do), I like your form concept :-)
0
 
Fi69Author Commented:
Hi Graham

I really need some help with this one! I don't know how to handle it at all.

I've refreshed the document at the below link, so that headings make more sense. To explain the problem I've done a little video to show you what I'm trying to do and the problem being experienced (excuse the voice - nasty cold at the moment).

Document
https://www.dropbox.com/s/6op1s4okcfpnm76/testing%20cr.docm

Video
https://www.dropbox.com/s/jkop5a7stjjola9/Tracked%20Change%20problem.mp4
0
 
DrTribosCommented:
It seems to me that there is a bug with:
mycr = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)

and you might need to loop through the document looking for numbered items...

Put cursor on Heading 2. and run this in the immediate window and you will see that you get a result...

?selection.Range.ListFormat.ListString
0
 
DrTribosCommented:
The other thing that I notice is that IF you put a space at the start of the missing headings (even with track changes turned on) they appear in the list.  Perhaps prior to running your macro you can find a way to add the space automagically?

HTH
0
 
DrTribosCommented:
It's nasty, but you might try:

Find: ^13
Replace with: ^13 & space

Graham, I should be in bed - would be keen to see if you can work with :-D
0
 
Fi69Author Commented:
HI DrTribos - what's the ^13, replace with ^13 & space doing?

The reason the space at the beginning of the paragraph will work is because it isn't a tracked deletion. The tracked deletion can appear anywhere else in the paragraph, but it causes a problem when it is the first word.

Problem with putting a space at the beginning of all the headings is the time to cycle through them all. I'm working with documents over 100 pages. I'll do what I have to do though.
0
 
DrTribosCommented:
Sorry for brevity. On phone keyboard
0
 
Fi69Author Commented:
Hi DrTribos

Okay I've tried that and it is definitely solves the problem - so I'm thrilled there's a workaround, thank you. I've added the following into the initialise code. I've got it activating only if there are tracked changes in the document.

It does slow things down though, so I'm open to any other ideas - Graham did you think of anything?

    If ThisDoc.Revisions.Count > 0 Then
        Application.ScreenUpdating = False
        Set myRange = ThisDoc.range(Start:=ThisDoc.Sections(ContentStartSecNo).range.Start, End:=ThisDoc.Sections(ThisDoc.Sections.Count).range.End)
        With myRange.Find
            .Text = "^p"
            .Replacement.Text = "^p "
            .Execute Replace:=wdReplaceAll
        End With
        Application.ScreenUpdating = True
    End If

Open in new window


Obviously there is code to remove the space on closing the form.
0
 
DrTribosCommented:
That's great - I'm pretty sure it will be about as quick as possible, but that said Graham is always my goto guy for elegant code ;-)
0
 
Fi69Author Commented:
Cool. I'll see what his take is on it.
0
 
DrTribosCommented:
How are you going with this one?
0
 
Fi69Author Commented:
Hi DrTribos, at this stage seems to be resolving the issue. Thank you.
0
 
DrTribosCommented:
No worries, thanks!
0
 
GrahamSkanRetiredCommented:
Hi, sorry both.
I wasn't in a position to contribute further, but I don't believe that I could have  bettered the outcome anyway.
0
All Courses

From novice to tech pro — start learning today.