Macro to return a word count of text contained within a bookmark

tomsrv · #1 08-21-2016, 04:34 AM

Hi,

I have a large document with tables that I require to complete to a pre-determined word count.

Could anyone please provide a macro that could count the number of works contained within a bookmark and then allow me to place this into a table. The macro could then be updated when I save the document for example.

I provide an image below which shows what I am trying to achieve. Please note the book mark symbols (grey square brackets).

Thank you

Tom

gmayor · #2 08-21-2016, 05:43 AM

In theory that is straightforward, though your idea of what constitues a 'word' to be counted my not coincide with Word's

Code:

Option Explicit

Sub Macro1()
Dim oTable As Table
Dim oRng As Range
Dim oBM As Range
    Set oTable = ActiveDocument.Tables(ActiveDocument.Tables.Count)
    If InStr(oTable.Cell(1, 1).Range.Text, "Bookmark") = 0 Then
        Set oRng = ActiveDocument.Range
        oRng.Collapse 0
        Set oTable = ActiveDocument.Tables.Add(oRng, 4, 2)
        Set oRng = oTable.Cell(1, 1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Bookmark"
        oRng.Font.Bold = True
        Set oRng = oTable.Cell(1, 2).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Word Count"
        oRng.Font.Bold = True
        Set oRng = oTable.Cell(2, 1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Sustainability"
        oRng.Font.Bold = True
        Set oRng = oTable.Cell(3, 1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Team Working"
        oRng.Font.Bold = True
        Set oRng = oTable.Cell(4, 1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Total"
        oRng.Font.Bold = False
        oTable.Rows(2).Shading.BackgroundPatternColor = &HD8EFE1
        oTable.Rows(4).Shading.BackgroundPatternColor = &HD8EFE1
    End If
    Set oBM = ActiveDocument.Bookmarks("Sustainability").Range
    Set oRng = oTable.Cell(2, 2).Range
    oRng.End = oRng.End - 1
    oRng.Text = oBM.Words.Count
    oRng.Font.Bold = False
    Set oBM = ActiveDocument.Bookmarks("TeamWorking").Range
    Set oRng = oTable.Cell(3, 2).Range
    oRng.End = oRng.End - 1
    oRng.Text = oBM.Words.Count
    oRng.Font.Bold = False
    Set oRng = oTable.Cell(4, 2).Range
    oRng.End = oRng.End - 1
    oRng.Text = ""
    ActiveDocument.Fields.Add oRng, wdFieldExpression, "SUM(ABOVE)", False
lbl_Exit:
    Set oTable = Nothing
    Set oRng = Nothing
    Set oBM = Nothing
    Exit Sub
End Sub

tomsrv · #3 08-21-2016, 05:51 AM

Thanks gmayor.

This looks really good but perhaps I was over complicating matters with my explanation of what I was looking for.

I have tried running the macro you have prepared but it doesn't work (I realise you have added names of bookmarks I require to add to get this to work).

Is it possible to only have a code that allows me to reference a bookmark's text's word count? I can then happily place these into a table and use word's built in tools for doing sum above and the like?

macropod · #4 08-21-2016, 06:28 AM

It's not clear to me why you'd need bookmarks or a macro. If you want to count the number of words in a block of text, simply select the range and Word will display the Word count on the status bar. Clicking on the word count will display additional stats, as will right-clicking on the status bar.

gmayor · #5 08-21-2016, 06:29 AM

The macro looks for two bookmarks named "Sustainability" and "TeamWorking" which relate to the bookmarks in your illustration (where they are not named). Change those names in the macro to the actual names and the macro will work to add or update the table shown in your illustration.

To get the word count of the bookmarked range containing the cursor

Code:

Dim orng As Range
    Set orng = Selection.Bookmarks(1).Range
    MsgBox orng.Words.Count

Paul is right, that bookmarks are not necessary, especially if you are going to do the job manually. Even with a macro you could have counted the words in the table cell without the need for a bookmark.

tomsrv · #6 08-21-2016, 06:39 AM

Thanks gmayor and macropod.

I am required to submit a document and fill in the text in the left most boxes of each cell.

The total requires to be under 1500 words but in actual fact I would be looking to go as close as possible to this number without exceeding it.

This document will receive a lot of criticism/comment from my colleagues, and as such I will have to edit it a lot. I will have to be mindful of the breakdown in word count, so in effect if I was to do the word count manually, I would need to do this many many times.

What my end goal is, is to have a table in hidden text with a break down of all totals for the left most cells.

I'm afraid I'm not sure how to use the last piece of code you have provided gmayor. Is it possible to add this to the attached word file and repost? I am very new to VBA for word.

Thank you

gmaxey · #7 08-21-2016, 07:28 AM

Perhaps something like this:

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim lngTable As Long
Dim lngIndex As Long, lngRow As Long, lngCount As Long
Dim arrCounts() As String
Dim oRng As Range
Dim oDoc As Document
  ReDim arrCounts(1 To ActiveDocument.Tables.Count)
  For lngTable = 1 To ActiveDocument.Tables.Count
    Set oTbl = ActiveDocument.Tables(lngTable)
    For lngRow = 2 To oTbl.Rows.Count
      Set oRng = oTbl.Cell(lngRow, oTbl.Columns.Count).Range
      oRng.End = oRng.End - 1
      arrCounts(lngTable) = oRng.ComputeStatistics(wdStatisticWords)
    Next lngRow
  Next lngTable
lbl_Exit:
  Set oDoc = Documents.Add
  Set oTbl = oDoc.Tables.Add(oDoc.Range, UBound(arrCounts), 2)
  For lngIndex = 1 To UBound(arrCounts)
    oTbl.Cell(lngIndex, 1).Range.Text = "Tabel " & lngIndex & " computed word count is: "
    oTbl.Cell(lngIndex, 2).Range.Text = arrCounts(lngIndex)
  Next
  Exit Sub
End Sub

tomsrv · #8 08-21-2016, 09:58 AM

That's getting very close to what I am after gmaxey thank you.

The only tweaks I would request is that you can specify in the macro bookmarks within which to calculate the word count.

When I run that macro it isn't obvious which word count matches which heading.

I.e. I would be grateful if your macro could examine the "Teamworking" book mark, and return a value against it in the results table.

I have demonstrated this in the screenshots.

Tom

gmaxey · #9 08-21-2016, 11:27 AM

I suppose that a part of the point of my code is that "bookmarks" are redundant and not necessary in your example document format. A bookmark is just a defined range. Well a table cell is also a defined range so you can use one or the other.

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim lngTable As Long
Dim lngIndex As Long, lngRow As Long, lngCount As Long
Dim arrCounts() As String
Dim oRng As Range
Dim oDoc As Document
  ReDim arrCounts(1 To ActiveDocument.Tables.Count, 1 To 2)
  For lngTable = 1 To ActiveDocument.Tables.Count
    Set oTbl = ActiveDocument.Tables(lngTable)
    For lngRow = 2 To oTbl.Rows.Count
      If lngRow = 2 Then
        Set oRng = oTbl.Cell(lngRow, 1).Range
        oRng.End = oRng.End - 1
        arrCounts(lngTable, 1) = oRng.Text
      End If
      Set oRng = oTbl.Cell(lngRow, oTbl.Columns.Count).Range
      oRng.End = oRng.End - 1
      arrCounts(lngTable, 2) = oRng.ComputeStatistics(wdStatisticWords)
    Next lngRow
  Next lngTable
lbl_Exit:
  Set oDoc = Documents.Add
  Set oTbl = oDoc.Tables.Add(oDoc.Range, UBound(arrCounts), 2)
  For lngIndex = 1 To UBound(arrCounts)
    oTbl.Cell(lngIndex, 1).Range.Text = arrCounts(lngIndex, 1)
    oTbl.Cell(lngIndex, 2).Range.Text = arrCounts(lngIndex, 2)
  Next
  Exit Sub
End Sub

tomsrv · #10 08-22-2016, 06:23 AM

Thanks gmaxey. I understand your point, but it isn't clear which count corresponds to which defined range. Could you please use bookmarks to achieve this?

gmaxey · #11 08-22-2016, 02:10 PM

You have a document that consists of tables. Column 1 defines the competency (the text in column 1 is the same as the names you gave the bookmarks). Column 3 defines a range of text that is counted. You have bookmarked it using the same name as you typed in column 1.

The code creates a table with the competency listed in column 1 and the word count in column 2. Therefore it is perfectly clear what range corresponds to a count so I am not going to waste my time writing code that uses bookmarks when you don't need the bookmarks in the first place.

tomsrv · #12 08-22-2016, 02:25 PM

Quote:

Originally Posted by gmaxey

You have a document that consists of tables. Column 1 defines the competency (the text in column 1 is the same as the names you gave the bookmarks). Column 3 defines a range of text that is counted. You have bookmarked it using the same name as you typed in column 1.

The code creates a table with the competency listed in column 1 and the word count in column 2. Therefore it is perfectly clear what range corresponds to a count so I am not going to waste my time writing code that uses bookmarks when you don't need the bookmarks in the first place.

The code is very good but by the nature of the tables (using merged cells etc) the macro doesn't seem to be able to create a sub-group of Health and Safety (e.g. Level 1 and Level 2), so this would be the only tweak to make in line with your comments. For my purposes, I need to do some word count analysis on paragraphs that will not be forming part of a table (i.e. I have to provide a case study which goes in a different word section to all the tabular stuff, and I have to exclude titles and have certain paras be certain word counts). For my purposes bookmarks would be useful as they could get around the issue of words not being in a table.

gmaxey · #13 08-22-2016, 07:08 PM

You still don't need bookmarks.

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim lngTable As Long
Dim lngIndex As Long, lngRow As Long, lngCount As Long
Dim arrCounts() As String
Dim oRng As Range
Dim oDoc As Document
Dim lngComp As Long
  For lngTable = 1 To ActiveDocument.Tables.Count
    lngComp = lngComp + (ActiveDocument.Tables(lngTable).Rows.Count - 1)
  Next lngTable
  ReDim arrCounts(1 To lngComp, 1 To 3)
  lngComp = 0
  For lngTable = 1 To ActiveDocument.Tables.Count
    Set oTbl = ActiveDocument.Tables(lngTable)
    For lngRow = 2 To oTbl.Rows.Count
      lngComp = lngComp + 1
      If lngRow = 2 Then
        Set oRng = oTbl.Cell(lngRow, 1).Range
        oRng.End = oRng.End - 1
        arrCounts(lngComp, 1) = oRng.Text
      End If
      Set oRng = oTbl.Cell(lngRow, 2).Range
      oRng.End = oRng.End - 1
      arrCounts(lngComp, 2) = oRng.Text
      Set oRng = oTbl.Cell(lngRow, oTbl.Columns.Count).Range
      oRng.End = oRng.End - 1
      arrCounts(lngComp, 3) = oRng.ComputeStatistics(wdStatisticWords)
    Next lngRow
  Next lngTable
lbl_Exit:
  Set oDoc = Documents.Add
  Set oTbl = oDoc.Tables.Add(oDoc.Range, UBound(arrCounts), 3)
  For lngIndex = 1 To UBound(arrCounts)
    oTbl.Cell(lngIndex, 1).Range.Text = arrCounts(lngIndex, 1)
    oTbl.Cell(lngIndex, 2).Range.Text = arrCounts(lngIndex, 2)
    oTbl.Cell(lngIndex, 3).Range.Text = arrCounts(lngIndex, 3)
  Next
  Exit Sub
End Sub

tomsrv · #14 08-24-2016, 02:26 AM

Thank you Greg that works very well

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
FORMTEXT field contained in INCLUDETEXT bookmark	emwinschuh	Word	1	08-17-2015 08:55 AM
A recurring word count macro?	bpanda	Word VBA	1	06-11-2013 07:17 AM
Word Count Macro	bpanda	Word VBA	1	01-11-2013 06:51 PM
Word 2003 - IncludeText Does Not Include Bookmark Text if in a Form Text Control	skarden	Word	1	12-12-2011 10:39 PM
*Word 2007 Macro for Character Count	gbartlet	Word	0	07-21-2010 11:12 AM