Modify Count Word Frequency to Count 2 Words Frequency

[Spotycus]

Hello Everyone,

Can someone help me convert this VBA code from "The Spreadsheet page" to be able to provide strings of words also? I would like to be able to have it return single word, two words, and three+ word possible suggestions. The goal is to be able to clean up the information from the bank description, create a list of possabilities, and then return the best matching suggestion per line.

I have a copy of the spreadsheet with my related information and the current modifications (to remove all numbers also) I made available but I do not know how to share the info. The sample work book is available through the link below and sample data is provided below the code.

Here is the code:
code from: Excel Tips From John Walkenbach

Option Explicit
 
Sub MakeWordList()
    Dim InputSheet As Worksheet
    Dim WordListSheet As Worksheet
    Dim PuncChars As Variant, NumChars 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(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*")
    NumChars = Array("0", "1", "2", "3", "4", "5", "6", _
        "7", "8", "9")
    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 all Numbers
        For i = 0 To UBound(NumChars)
            txt = Replace(txt, NumChars(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

[TABLE="width: 100"]
<tbody>[TR]
[TD][TABLE="width: 467"]
<tbody>[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5108727985 01/04[/TD]
[/TR]
[TR]
[TD]TUNING FORK STUDIO CITY CA                   01/02[/TD]
[/TR]
[TR]
[TD]UNITED OIL #10 SIMI VALLEY CA        004804  01/02[/TD]
[/TR]
[TR]
[TD]S  amp; G ENERGY  INC CAMARILLO CA       427481  01/04[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]ADP EEPAY/GARNWC EEPAY/GARN 090068028OA CCD ID: 9628006057[/TD]
[/TR]
[TR]
[TD]ADP Tax/401k     Tax/401k   RP8OA 909501A01 CCD ID: 1228006057[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5112682661 01/05[/TD]
[/TR]
[TR]
[TD]CRUSTACEAN BEVERLY H BEVERLY HILLS CA        01/08[/TD]
[/TR]
[TR]
[TD]STATE OF CALIF DMV INT 800-7770162 CA        01/04[/TD]
[/TR]
[TR]
[TD]BKCD PROCESSING  BKCD M DSC 275000791515    CCD ID: 9000477845[/TD]
[/TR]
[TR]
[TD]CRUSTACEAN BEVERLY H BEVERLY HILLS CA        01/08[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]STAMPS.COM 909-608-2677 CA                   01/06[/TD]
[/TR]
[TR]
[TD]AMERIPRISE INS   HOME PREM                  PPD ID: 1891178498[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5120019680 01/08[/TD]
[/TR]
[TR]
[TD]ARCO #42797 SIMI VALLEY CA           826292  01/07[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5124718168 01/11[/TD]
[/TR]
[TR]
[TD]USPS POSTAGE STAMPS.COM WASHINGTON DC        01/09[/TD]
[/TR]
[TR]
[TD]PANERA BREAD#8181 CAMARILLO CA               01/08[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5125778180 01/12[/TD]
[/TR]
[TR]
[TD]PANERA BREAD#8181 CAMARILLO CA               01/11[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5128702177 01/18[/TD]
[/TR]
[TR]
[TD]Online Payment 5059689627 To BANK OF AMERICA 01/18[/TD]
[/TR]
[TR]
[TD]Online Transfer to CHK ...0568 transaction#: 5127707811 01/18[/TD]
[/TR]
[TR]
[TD]GRILL CONCEPTS - P WESTLAKE VILL CA          01/12[/TD]
[/TR]
[TR]
[TD]REMOTE ONLINE DEPOSIT #          1[/TD]
[/TR]
[TR]
[TD]Online Payment 506[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

Thanks again for any assistance

 

[István Hirsch]

If you want to count the occurrence of two consecutive words, delete the space between them and get the needed frequency as if it was a single word.