Output at the end of the text of all links using VBA

Yarandlo · #1 02-17-2023, 06:03 AM

Hi everybody.

I write a lot of text, and in scientific publications I often indicate references in the form [1] [2] [3]. When there are a lot of them (more than a hundred), it is very difficult to manually check whether the numbering order has been lost. Please help me with a macro so that after running the macro at the end of the text it displays all the links, so that I can then check if I followed the correct numbering of the links.

For example, it went like this:

Some text [1]. Text [2]. More text [3]. Text [4]. Text [5]. And so on…

And this is how it should be after running the macro:

Some text [1]. Text [2]. More text [3]. Text [4]. Text [5]. And so on…
[1] [2] [3] [4] [5]

gmayor · #2 02-17-2023, 07:01 AM

It might make more sense for the future to use automatic numbering so you won't have the problem with missed references, however

Code:

Sub Macro1()
Dim oRng As Range
Dim sText As String
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        Do While .Execute(findText:="\[[0-9]{1,}\]", _
                          MatchWildcards:=True, _
                          Wrap:=wdFindStop, _
                          Forward:=True) = True
            Set oRng = Selection.Range
            sText = sText & oRng.Text & Chr(32)
        Loop
    End With
    ActiveDocument.Range.InsertAfter vbCr & sText
lbl_Exit:
    Exit Sub
End Sub

Yarandlo · #3 02-18-2023, 07:46 AM

Thanks for the automated links tip.

gmayor · #4 02-18-2023, 10:33 PM

Given that you are attracted to autonumbering as suggested, the following macros will address that. The first replaces your numbered items with Sequence fields. The second will add a number using the same sequence and update the sequence to reflect the addition.

Code:

Sub ReplaceNumbers()
Dim oRng As Range
    ActiveWindow.ActivePane.View.ShowFieldCodes = True
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="\[[0-9]{1,}\]", _
                          MatchWildcards:=True, _
                          Wrap:=wdFindStop, _
                          Forward:=True) = True
            oRng.Fields.Add oRng, wdFieldSequence, "List\# ""'['0']'""", False
            oRng.Collapse 0
        Loop
    End With
    ActiveWindow.ActivePane.View.ShowFieldCodes = False
lbl_Exit:
Set oRng = Nothing
    Exit Sub
End Sub

Sub AddNumber()
Dim oRng As Range
Dim oField As Field
    ActiveWindow.ActivePane.View.ShowFieldCodes = True
    Set oRng = Selection.Range
    oRng.Fields.Add oRng, wdFieldSequence, "List\# ""'['0']'""", False
    oRng.Collapse 0
    ActiveWindow.ActivePane.View.ShowFieldCodes = False
    For Each oRng In ActiveDocument.StoryRanges
        For Each oField In oRng.Fields
            oField.Update
        Next oField
    Next oRng
lbl_Exit:
    Set oRng = Nothing
    Set oField = Nothing
    Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Userform to output specific text	~clover	Word VBA	2	06-01-2019 07:04 AM
Content Control Listbox output to text box possible?	VGW	Word VBA	2	07-05-2018 04:18 PM
Outlook Template: Trying to Output text and fields	back2ict	Outlook	0	07-03-2018 08:57 AM
How do I output text to a specific cell (x,y)?	norwood	Word VBA	2	01-31-2014 08:43 AM
Generating text output from PowerPoint picture/name slides	bornslippy	PowerPoint	2	12-05-2013 11:04 AM