Microsoft Office Forums - View Single Post - [Solved] VBA Move Footnote References Before Punctuation

macropod · 08-17-2022, 08:02 AM

To ensure punctuation etc. is placed before footnotes, endnotes and cross-references to them, use:

Code:

Sub FootnoteEndnotePunctBef()
Application.ScreenUpdating = False
Dim FtNt As Footnote, EndNt As Endnote, Rng As Range, Fld As Field
With ActiveDocument
  For Each FtNt In .Footnotes
    Set Rng = FtNt.Reference
    With Rng
      'Eliminate any spaces before the footnote
      Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
        .Characters.First.Previous.Text = vbNullString
      Loop
      'Swap the footnote/punctuation, as applicable
      Do While .Characters.Last.Next Like "[!0-9A-Za-z]"
        .InsertBefore .Characters.Last.Next
        .Characters.Last.Next.Delete
      Loop
    End With
  Next
  For Each EndNt In .Endnotes
    Set Rng = EndNt.Reference
    With Rng
      'Eliminate any spaces before the footnote
      Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
        .Characters.First.Previous.Text = vbNullString
      Loop
      'Swap the footnote/punctuation, as applicable
      Do While .Characters.Last.Next Like "[!0-9A-Za-z]"
        .InsertBefore .Characters.Last.Next
        .Characters.Last.Next.Delete
      Loop
    End With
  Next
  For Each Fld In .Range.Fields
    With Fld
      If .Type = wdFieldNoteRef Then
        'Swap the footnote/punctuation, as applicable
        With .Result
          Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
            .Characters.First.Previous.Text = vbNullString
          Loop
          'Swap the footnote/punctuation, as applicable
          Do While Not .Characters.Last.Next Like "[0-9A-Za-z]"
            .InsertBefore .Characters.Last.Next
            .Characters.Last.Next.Delete
          Loop
        End With
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

To ensure punctuation etc. is placed after footnotes, endnotes and cross-references to them, use:

Code:

Sub FootnoteEndnotePunctAft()
Application.ScreenUpdating = False
Dim FtNt As Footnote, EndNt As Endnote, Rng As Range, Fld As Field
With ActiveDocument
  For Each FtNt In .Footnotes
    Set Rng = FtNt.Reference
    With Rng
      'Eliminate any spaces before the footnote
      Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
        .Characters.First.Previous.Text = vbNullString
      Loop
      'Swap the footnote/punctuation, as applicable
      Do While Not .Characters.First.Previous Like "[0-9A-Za-z]"
        .InsertAfter .Characters.First.Previous
        .Characters.First.Previous.Delete
      Loop
    End With
  Next
  For Each EndNt In .Endnotes
    Set Rng = EndNt.Reference
    With Rng
      'Eliminate any spaces before the footnote
      Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
        .Characters.First.Previous.Text = vbNullString
      Loop
      'Swap the footnote/punctuation, as applicable
      Do While Not .Characters.First.Previous Like "[0-9A-Za-z]"
        .InsertAfter .Characters.First.Previous
        .Characters.First.Previous.Delete
      Loop
    End With
  Next
  For Each Fld In .Range.Fields
    With Fld
      If .Type = wdFieldNoteRef Then
        'Swap the footnote/punctuation, as applicable
        With .Result
          Do While .Characters.First.Previous Like "[ " & Chr(160) & "]"
            .Characters.First.Previous.Text = vbNullString
          Loop
          'Swap the footnote/punctuation, as applicable
          Do While Not .Characters.First.Previous Like "[0-9A-Za-z]"
            .InsertAfter .Characters.First.Previous
            .Characters.First.Previous.Delete
          Loop
        End With
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub