Results 1 to 10 of 10

Text count in word to text count in excel.

Threaded View

  1. #1
    Registered User
    Join Date
    06-27-2012
    Location
    othseco correct
    MS-Off Ver
    Excel 2010
    Posts
    37

    Text count in word to text count in excel.

    I need some help. Found this code that will count all the words in a document and give me a list of each word and the frequency. I need it to count the words on a spread sheet collum A for example and provide me same results on a new sheet. can someone help me convert the macro from reading a word document to reading a collum of text strings in Collum A of the sheet and providing the results in a row of words in Collum A of the new sheet with the frequency in collum B of the new sheeet? Here is the code.

    Thanks
    Chris
    Sub WordFrequency()
        Const maxwords = 9000          'Maximum unique words allowed
        Dim SingleWord As String       'Raw word pulled from doc
        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 ans As String              'How user wants to sort results
        Dim tword As String            '
    
        ' Set up excluded words
        Excludes = "[the][a][of][is][to][for][by][be][and][are][i]"
    
        ' Find out how to sort
        ByFreq = True
        ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
        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
    
        ' Control the repeat
        For Each aword In ActiveDocument.Words
            SingleWord = Trim(LCase(aword))
            'Out of range?
            If SingleWord < "a" Or SingleWord > "z" Then
                SingleWord = ""
            End If
            'On exclude list?
            If InStr(Excludes, "[" & SingleWord & "]") Then
                SingleWord = ""
            End If
            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("Too many words.", 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:=Trim(Str(Freq(j))) _
                  & vbTab & Words(j) & vbCrLf
            Next j
        End With
        System.Cursor = wdCursorNormal
        j = MsgBox("There were " & Trim(Str(WordNum)) & _
          " different words ", vbOKOnly, "Finished")
    End Sub
    Last edited by frisbie17; 09-27-2012 at 04:53 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1