Macro to produce a list of all the unique words in a doc

RRB · #1 02-21-2024, 11:02 AM

Hi friends!

I needed a macro that would list all the unique words in the doc, in order to check consistency. I found one at

http://https://wordribbon.tips.net/T...que_Words.html

But, as he explicitly states it does not scan the footnote area. I don't think it would pick up words in parentheses either (not sure about that though).

Could someone help me expand this macro to scan the footnote area as well in other words the whole document all over from beginning to end?

Thank you and have a good day!

Susan Flamingo

AlanCantor · #2 02-21-2024, 07:16 PM

The link doesn't work, but this one should:

Generating a List of Unique Words (Microsoft Word)

gmaxey · #3 02-23-2024, 06:40 AM

You can try:
Word Usage & Frequency Report

macropod · #4 02-25-2024, 03:29 PM

See also: https://www.msofficeforums.com/31360-post2.html

ladracer · #5 03-03-2024, 02:30 PM

Hats off to both Mr. Maxey and Mr. Edstein for their word count macros.

I tried both and as wonderful as they are, they don't seem to work for my admittedly obscure situation.

I am looking to get a "word count" for eight jinja expressions, specifically: % if, % elif, % else, % endif, %p if, %p elif, %p else, and %p endif.

Ideally this could be accomplished in batch. That is, I direct the macro to a folder and it processes each of the .docx files in the folder and spits out a table with the name of the document in column 1 of a row and the corresponding word counts (for the 8 expressions) in columns 2-9.

Is there a means to force the Word Usage and Frequency Report Macro to do this, or if not, a relatively easy means to convert Mr. Edstein's macro to accomplish this?

gmaxey · #6 03-03-2024, 04:11 PM

This should get you started. There are lots of examples out there on how to write code to loop through the files in a folder.

Code:

Sub ScratchMacro()
'A basic Word Macro coded by Gregory K. Maxey
Dim strSrch() As String
Dim lngIndex As Long
Dim oRng As Range
Dim lngCount As Long
Dim oTbl As Table
  Set oTbl = ActiveDocument.Tables(1)
  strSrch = Split("% if|% elif|% else|% endif|%p if|%p elif|%p else|%p endif", "|")
  oTbl.Rows(2).Cells(1).Range.Text = ActiveDocument.FullName
  For lngIndex = 0 To UBound(strSrch)
    lngCount = 0
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .Text = strSrch(lngIndex)
      While .Execute
        lngCount = lngCount + 1
        oRng.Collapse wdCollapseEnd
      Wend
      oTbl.Rows(2).Cells(lngIndex + 2).Range.Text = lngCount
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub

ladracer · #7 03-03-2024, 05:20 PM

Mr. Maxey, Thank you for your help.

I just tried to run the macro and Word didn't like its name so once that was remedied, I tried it again, this time it errored and pointed to this line:

oTbl.Rows(2).Cells(1).Range.Text = ActiveDocument.FullName

The error stated: Run-time error '5941':
The requested member of the collection does not exist.

Any ideas what I may have done wrong?

gmaxey · #8 03-03-2024, 05:33 PM

Well you will have to add a table two or more rows with nine columns.

This code is basic just to get you started.

gmaxey · #9 03-03-2024, 05:36 PM

In practice, the table will be in the main document (the one running the code).

e.g.,
Dim oDocMain as Document
Dim oDocQuery as Document
Set oDocMain = ActiveDocument
Set oTbl = oDocMain.Tables(1)
For Each oDocQuery In ... "Target folder of documents"

Next oDocQuery

ladracer · #10 03-03-2024, 06:34 PM

I created a document with a bevy of rows and 9 columns.

I attempted to run the code you provided with a slight modification and it states:

Compile error: For Each may only iterate over a collection object or an array

Sub JinjaSearch()
'A basic Word Macro coded by Gregory K. Maxey
Dim strSrch() As String
Dim strFolder As String
Dim strFile As String
Dim lngIndex As Long
Dim oRng As Range
Dim lngCount As Long
Dim oDocMain As Document
Dim oDocQuery As Document
Set oDocMain = ActiveDocument
Set oTbl = oDocMain.Tables(1)
'Dim oTbl As Table
' Pop up input boxes for user to enter folder path, the finding and replacing texts.
strFolder = InputBox("Enter the folder path to the documents you want to change here:")
'For Each oDocQuery In strFolder
For Each oDocQuery In strFolder
Set oTbl = ActiveDocument.Tables(1)
strSrch = Split("% if|% elif|% else|% endif|%p if|%p elif|%p else|%p endif", "|")
oTbl.Rows(2).Cells(1).Range.Text = ActiveDocument.FullName
For lngIndex = 0 To UBound(strSrch)
lngCount = 0
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = strSrch(lngIndex)
While .Execute
lngCount = lngCount + 1
oRng.Collapse wdCollapseEnd
Wend
oTbl.Rows(2).Cells(lngIndex + 2).Range.Text = lngCount
End With
Next
Next oDocQuery
lbl_Exit:
Exit Sub
End Sub

Where did I go wrong this time?

gmaxey · #11 03-04-2024, 01:46 AM

ladracer,

"A" for effort. Thank you. While many think we are a free code writing service, our (or at least most of us) objective is to help you learn VBA. Your error message has told you one place you went wrong.

You declared strFolder as a string, and you set it's value to a string. A string variable is not a collection object. Instead of typing in the folder path, you can use the application folder picker:

Code:

  Dim oDlg as FileDialong

  Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
  If oDlg.Show <> -1 Then Exit Sub
  strFolder = oDlg.SelectedItems(1) & Application.PathSeparator

Again that is just going to return a string value e.g., "C:\My Files\My Batch Folder"

Now you need to iterate through and open each of .doc? files in the folder defined by that string. Look up and see what you find out about the Dir() function. There is your clue.

There will be other gotchas. You will need a row for each file in your folder. A "bevy" may not be enough. Instead of a "bevy" why not just one? Then in your code, as you iterate over each file, add a row. Also in your current code, you are always going to overwrite your data in row 2. You need to index that row number with each file processed.

gmaxey · #12 03-04-2024, 01:11 PM

After exchanging a few PMs with ladracer, we came up with the following that works:

Code:

Sub JinjaSearch()
'A basic Word Macro coded by Gregory K. Maxey
Dim oDlg As FileDialog
Dim strFolder As String
Dim strFile As String
Dim strSrch() As String
Dim lngIndex As Long, lngFileIndex As Long
Dim oRng As Range
Dim lngCount As Long
Dim oDocMain As Document
Dim oTbl As Table
Dim oDocQuery As Document

'strSrch = Split("% if|% elif|% else|% endif|%p if|%p elif|%p else|%p endif", "|")
'strSrch = Split("% if|% endif|%p if|%p endif|%tr for|%tr endfor|%tc for|%tc endfor", "|")
strSrch = Split("% if|% endif|%p if|%p endif", "|")
Set oDocMain = ActiveDocument
Set oTbl = oDocMain.Tables(1)
Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
If oDlg.Show <> -1 Then Exit Sub
strFolder = oDlg.SelectedItems(1) & Application.PathSeparator
strFile = Dir(strFolder & "*.doc?")
While strFile <> ""
lngFileIndex = lngFileIndex + 1
oTbl.Rows.Add
Set oDocQuery = Documents.Open(FileName:=strFolder & strFile, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
Format:=wdOpenFormatAuto, XMLTransform:="")
oTbl.Rows(lngFileIndex + 1).Cells(1).Range.Text = oDocQuery.FullName
For lngIndex = 0 To UBound(strSrch)
lngCount = 0
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = strSrch(lngIndex)
While .Execute
lngCount = lngCount + 1
oRng.Collapse wdCollapseEnd
Wend
oTbl.Rows(lngFileIndex + 1).Cells(lngIndex + 2).Range.Text = lngCount
End With
Next lngIndex
oDocQuery.Close 0
strFile = Dir()
Wend
lbl_Exit:
Exit Sub
End Sub

ladracer · #13 03-04-2024, 02:53 PM

to wash behind your ears and create a table with at least one row, within a Word document with the appropriate number of columns (the number of "words" searched +1).

I placed my headings in that first row. The nifty macro will create new rows as needed.

Then run the macro from this document that contains the newly created 1 row table.

Recall that the folder prompt will be the location of the files that you desire to be searched.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to Find & Highlight Words from List	DRD992	Word VBA	15	06-17-2023 05:06 AM
Sorting does not produce an alphabetical list.	alanterrill	Word	7	11-22-2022 12:31 PM
Macro to highlight a list of words	bakerkr	Word VBA	4	10-19-2017 02:23 PM
Create list of unique words	trainingclc	Excel Programming	3	09-29-2015 06:43 AM
Easiest Way to Produce a Report/List of Tagged Text from Multiple Word Files	bxchk	Word	5	04-29-2014 03:23 PM