Problem in VB coding for a cumulative word count

Question

Firstly, I apologise if this is completely the incorrect place to come. (I don't even know whether the tag is correct or not!)

With that said, here is my question:

I am trying to use this code, provided by the user macropod from an old thread, to implement a cumulative word count into a document:

Sub CountWords()
Application.ScreenUpdating = False
Dim i As Long, j As Long, Rng As Range
Dim Shp As Shape, Rct As Rectangle
Dim vPos As Single, hPos As Single
With ActiveDocument
On Error Resume Next
With .PageSetup
vPos = .PageHeight - .TopMargin
hPos = .PageWidth - 105
End With
For i = 1 To .ComputeStatistics(wdStatisticPages)
With .ActiveWindow.Panes(1).Pages(i)
j = 0
For Each Rct In .Rectangles
j = j + Rct.Range.ComputeStatistics(wdStatisticWords)
Next
Set Rng = .Rectangles(1).Range.Paragraphs.Last.Range
Rng.Collapse wdCollapseStart
End With
Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=hPos, Top:=vPos, Width:=100, Height:=35, Anchor:=Rng)
With Shp.TextFrame.TextRange
.Text = "Page Word Count Statistics: " & j
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceAfter = 0
End With
Next
End With
Application.ScreenUpdating = True
End Sub

Broadly, it works. It creates the word boxes with the correct page numbers, but sometimes it will produce two of these texts boxes, for page x and y, on top of each other, on page x. Occasionally it will do that with three or four pages. I can simply drag the boxes down to the appropriate pages, but I was wondering if there was something I could change/add/subtract to/from the code to solve this problem.

Thank you in anticipation.