A Macro To Count Word Frequencies

Category: General VBA | [Item URL]

A companion file is available: Click here to download

This tip describes a VBA macro that analyzes a list of text, and counts the frequency of each word. The macro works with any text. It assumes that the data begins in cell A1 of the active sheet, and the first blank cell in the column signals the end of the text.

The general approach is:

  1. Add a new worksheet for the results
  2. Remove all punctuation characters from the input text
  3. Convert each word to upper case, and remove excess spaces
  4. Loop through the input text and put each word in the results sheet
  5. Create a pivot table that uses the word list and displays a frequency count for each word.

Here's the macro:

Sub MakeWordList()
    Dim InputSheet As Worksheet
    Dim WordListSheet As Worksheet
    Dim PuncChars As Variant, x As Variant
    Dim i As Long, r As Long
    Dim txt As String
    Dim wordCnt As Long
    Dim AllWords As Range
    Dim PC As PivotCache
    Dim PT As PivotTable
    
    Application.ScreenUpdating = False
    Set InputSheet = ActiveSheet
    Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True
    InputSheet.Activate
    wordCnt = 2
    PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*")
    r = 1

'   Loop until blank cell is encountered
    Do While Cells(r, 1) <> ""
'       covert to UPPERCASE
        txt = UCase(Cells(r, 1))
'       Remove punctuation
        For i = 0 To UBound(PuncChars)
            txt = Replace(txt, PuncChars(i), "")
        Next i
'       Remove excess spaces
        txt = WorksheetFunction.Trim(txt)
'       Extract the words
        x = Split(txt)
        For i = 0 To UBound(x)
            WordListSheet.Cells(wordCnt, 1) = x(i)
            wordCnt = wordCnt + 1
        Next i
    r = r + 1
    Loop
    
'   Create pivot table
    WordListSheet.Activate
    Set AllWords = Range("A1").CurrentRegion
    Set PC = ActiveWorkbook.PivotCaches.Add _
        (SourceType:=xlDatabase, _
        SourceData:=AllWords)
    Set PT = PC.CreatePivotTable _
        (TableDestination:=Range("C1"), _
        TableName:="PivotTable1")
    With PT
        .AddDataField .PivotFields("All Words")
        .PivotFields("All Words").Orientation = xlRowField
    End With
End Sub


Search for Tips


All Tips

Browse Tips by Category

Tip Books

Needs tips? Here are two books, with nothing but tips:

Contains more than 200 useful tips and tricks for Excel 2007 | Other Excel 2007 books | Amazon link: John Walkenbach's Favorite Excel 2007 Tips & Tricks

Contains more than 100 useful tips and tricks for Excel 2013 | Other Excel 2013 books | Amazon link: 101 Excel 2013 Tips, Tricks & Timesavers

© Copyright 2016, J-Walk & Associates, Inc.
Privacy Policy