I’m embarrassed that I have another problem so soon, and after this I promise that I won’t ask any more questions for at a least a month. I have 1000s of other things to do and I’m sure you do too. My notion of using your solution as a template for other macros has failed miserably.

The first part of the following macro is the code you gave me yesterday. It deletes the red footnote numbers. My idea was to copy and paste the “Do While” loop onto the end of the second part after removing the “Selection.Find.Execute Replace:=wdReplaceAll” line. Evidently my plan wasn’t fool-proof.

At the minute the code works great – it cleans up the red footnotes that have been moved into the text. It deletes the footnote numbers and then changes the size and colour of the footnotes (which are now in the text) to match the size and colour of the surrounding text.

But when I try to add the loop to the end of the second part (which is also the end of the macro) so that I can count the changes, it won’t loop, it only makes one change and then stops.


Sub CleanupMovedFootnotes()
' Delete Red in-text footnote numbers
Dim x As Long
With Selection.Find
.ClearFormatting
.Font.Color = wdColorRed
.Replacement.ClearFormatting
.Text = "^2 "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
Do While .Execute(Replace:=wdReplaceOne)
x = x + 1
Loop
End With

' Change in-text Red Size 9 To Black Size 10
With Selection.Find.Font
.Size = 9
.Color = wdColorRed
End With

With Selection.Find.Replacement.Font
.Size = 10
.Color = wdColorAutomatic
End With

With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
MsgBox "Replaced: " & x
End Sub