Identify Common Words (and combination of)

Hi,

I've found this piece of VBA code on the forum (http://excel.bigresource.com/Track/excel-vFGPjVz4/) which lists the the number of times a word and combination of words is used from a column in Excel. I'd like to replicate it using a table in access containing the 'free text' and by creating a table for the output with a singlular list of words/combination of words.
e.g. tbl_FrequencyOutput
Col1= No of Words
Col 2= Word/Combination
Col 3= Count of combination in list.

Sub Test()
    PhraseDensity 1, "B"
    PhraseDensity 2, "D"
    PhraseDensity 3, "F"
End Sub

Sub PhraseDensity(nWds As Long, Col As Variant)
    Dim astr()      As String
    Dim i           As Long
    Dim j           As Long
    Dim cell        As Range
    Dim sPair       As String
    Dim rOut        As Range

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
            astr = Split(Letters(cell.Value), " ")

            For i = 0 To UBound(astr) - nWds + 1
                sPair = vbNullString
                For j = i To i + nWds - 1
                    sPair = sPair & astr(j) & " "
                Next j
                sPair = Left(sPair, Len(sPair) - 1)

                If Not .exists(sPair) Then
                    .Add sPair, 1
                Else
                    .Item(sPair) = .Item(sPair) + 1
                End If
            Next i
        Next cell

        Set rOut = Columns(Col).Resize(.Count, 2).Cells
        rOut.EntireColumn.ClearContents

        rOut.Columns(1).Value = Application.Transpose(.Keys)
        rOut.Columns(2).Value = Application.Transpose(.Items)

        rOut.Sort Key1:=rOut(1, 2), Order1:=xlDescending, _
                  Key2:=rOut(1, 1), Order1:=xlAscending, _
                  MatchCase:=False, Orientation:=xlTopToBottom, Header:=xlNo
        rOut.EntireColumn.AutoFit
    End With
End Sub

Function Letters(s As String) As String
    Dim i           As Long

    For i = 1 To Len(s)
        Select Case Mid(s, i, 1)
            Case "A" To "Z", "a" To "z", "'"
                Letters = Letters & Mid(s, i, 1)
            Case Else
                Letters = Letters & " "
        End Select
    Next i
    Letters = WorksheetFunction.Trim(Letters)
End Function

I appreciate any assistance.

Regards,

H

This code is a good one and its very usefull