Tools to Boost Motivation and Productivity

For a more accurate count of words change the following statements:

StartCount = ActiveDocument.Words.Count
to
StartCount = ActiveDocument.Range.ComputeStatistics(wdStatisticWords)

NowCount = ActiveDocument.Words.Count
to
NowCount = ActiveDocument.Range.ComputeStatistics(wdStatisticWords)

The following macros will place a small window at the top left of the screen to display the total number of words, the number added in the current session and the number added in the last hour. The totals are updated every minute.

Along with the macros it is necessary to create a user form of any size with the name ‘UserForm1’ and place in the form a label control called ‘Label1’. These are default names when created with the Visual Basic editor.

The macros and userform should be placed in a template file with a .dotm extension and the template file stored in the STARTUP folder. After re-starting Word the InitialiseWordCount macro can the run from the Developer > Macros command. Alternatively, the macro can be run from a button on the Quick Access Toolbar (QAT). Clicking on the x at the top right of the counter window will close the window and after a minute will shut down the macros.

Instructions on how to setup macros, templates and QAT buttons are available in various WordTips tools.

The counter will work in versions of Word from 2010 or higher. It will not work in Word for Mac. A shortcoming is that switching to another document will shut down the timer and the count will freeze.

Dim k As Long
Dim NowCount As Long
Dim StartCount As Long
Dim HourCount As Long
Dim OneMin(59) As Long

Sub InitialiseWordCount()
With UserForm1
.StartUpPosition = 0
.Left = 0
.Top = 0
.Width = 102
.Height = 54
.Caption = "Word counts"
With .Label1
.Left = 6
.Top = 0
.Width = 84
.Height = 28
End With
.Show vbModeless
End With
StartCount = ActiveDocument.Words.Count
For k = 0 To 59
OneMin(k) = StartCount
Next k
HourCount = StartCount
k = 0
WordCount
End Sub

Sub WordCount()
If Not UserForm1.Visible Then Exit Sub
NowCount = ActiveDocument.Words.Count
UserForm1.Label1.Caption = _
Str(NowCount) & " total in doc" & vbCrLf & _
Str(NowCount - StartCount) & " in session" & vbCrLf & _
Str(NowCount - OneMin(k)) & " in last 60 mins"
OneMin(k) = NowCount
k = k + 1
If k > 59 Then k = 0
' ----- loop back in one minute -----
Application.OnTime Now + TimeValue("00:01:00"), "WordCount"
End Sub