Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Catalog all words in document
I'm trying to organize responses from a survey. Much of the survey was typed
responses. I can scan all the surveys into a Word document, but I'm looking for a way to catalog every word within that document. For example, I would like the results to list the most used word to least used word. It might look something like this: the: 322 and: 301 property: 290 school: 250 uniforms: 231 of: 222 cooperatiion: 201 The intent of the survey was to gather suggestions for a school, so the most used words would be very revealing. Any ideas? |
#2
|
|||
|
|||
Run the following macro:
Sub WordFrequency() Dim SingleWord As String 'Raw word pulled from doc Const maxwords = 9000 'Maximum unique words allowed Dim Words(maxwords) As String 'Array to hold unique words Dim Freq(maxwords) As Integer 'Frequency counter for Unique Words Dim WordNum As Integer 'Number of unique words Dim ByFreq As Boolean 'Flag for sorting order Dim ttlwds As Long 'Total words in the document Dim Excludes As String 'Words to be excluded Dim Found As Boolean 'Temporary flag Dim j, k, l, Temp As Integer 'Temporary variables Dim tword As String ' ' Set up excluded words ' Excludes = "[the][a][of][is][to][for][this][that][by][be][and][are]" Excludes = "" Excludes = InputBox$("Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Excludes = Excludes & InputBox$("The following words are excluded: " & Excludes & ". Enter words that you wish to exclude, surrounding each word with [ ].", "Excluded Words", "") ' Find out how to sort ByFreq = True Ans = InputBox$("Sort by WORD or by FREQ?", "Sort order", "FREQ") If Ans = "" Then End If UCase(Ans) = "WORD" Then ByFreq = False End If Selection.HomeKey Unit:=wdStory System.Cursor = wdCursorWait WordNum = 0 ttlwds = ActiveDocument.Words.Count Totalwords = ActiveDocument.Words.Count ' Control the repeat For Each aword In ActiveDocument.Words SingleWord = Trim(aword) If SingleWord "A" Or SingleWord "z" Then SingleWord = "" 'Out of range? If InStr(Excludes, "[" & SingleWord & "]") Then SingleWord = "" 'On exclude list? If Len(SingleWord) 0 Then Found = False For j = 1 To WordNum If Words(j) = SingleWord Then Freq(j) = Freq(j) + 1 Found = True Exit For End If Next j If Not Found Then WordNum = WordNum + 1 Words(WordNum) = SingleWord Freq(WordNum) = 1 End If If WordNum maxwords - 1 Then j = MsgBox("The maximum array size has been exceeded. Increase maxwords.", vbOKOnly) Exit For End If End If ttlwds = ttlwds - 1 StatusBar = "Remaining: " & ttlwds & " Unique: " & WordNum Next aword ' Now sort it into word order For j = 1 To WordNum - 1 k = j For l = j + 1 To WordNum If (Not ByFreq And Words(l) Words(k)) Or (ByFreq And Freq(l) Freq(k)) Then k = l Next l If k j Then tword = Words(j) Words(j) = Words(k) Words(k) = tword Temp = Freq(j) Freq(j) = Freq(k) Freq(k) = Temp End If StatusBar = "Sorting: " & WordNum - j Next j ' Now write out the results tmpName = ActiveDocument.AttachedTemplate.FullName Documents.Add Template:=tmpName, NewTemplate:=False Selection.ParagraphFormat.TabStops.ClearAll With Selection For j = 1 To WordNum .TypeText Text:=Words(j) & vbTab & Trim(Str(Freq(j))) & vbCrLf Next j End With ActiveDocument.Range.Select Selection.ConvertToTable Selection.Collapse wdCollapseStart ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1) ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Word" ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Occurrences" ActiveDocument.Tables(1).Range.ParagraphFormat.Ali gnment = wdAlignParagraphCenter ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Total words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Totalwords ActiveDocument.Tables(1).Rows.Add ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 1).Range.InsertBefore "Number of different words in Document" ActiveDocument.Tables(1).Cell(ActiveDocument.Table s(1).Rows.Count, 2).Range.InsertBefore Trim(Str(WordNum)) System.Cursor = wdCursorNormal ' j = MsgBox("There were " & Trim(Str(WordNum)) & " different words ", vbOKOnly, "Finished") Selection.HomeKey wdStory End Sub -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Brad A." Brad wrote in message ... I'm trying to organize responses from a survey. Much of the survey was typed responses. I can scan all the surveys into a Word document, but I'm looking for a way to catalog every word within that document. For example, I would like the results to list the most used word to least used word. It might look something like this: the: 322 and: 301 property: 290 school: 250 uniforms: 231 of: 222 cooperatiion: 201 The intent of the survey was to gather suggestions for a school, so the most used words would be very revealing. Any ideas? |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
numbering chapter sub headings | Microsoft Word Help | |||
I do not have a blank document in words 2003 | Microsoft Word Help | |||
How do I build a word list with number of occurrences of each wor. | Microsoft Word Help | |||
Word frequencies | Microsoft Word Help | |||
Create a new ms words document from excel? | New Users |