Unique word count from free text

stevewhat · Dec 29th 2010

Long time reader, first time poster

What I am trying to achieve is a word cloud visualisation of customer feedback from survey data that is exported in .csv. I found this to achieve the word cloud: http://chandoo.org/wp/2008/04/…louds-in-excel-using-vba/

So what I need to get is a count of the various words in the survey data to get that to work.

What I have is a file with many hundreds of cells with various lengths and numbers of sentences in individual cells. Using text to columns I could get thousands of cells across a worksheet with individual words but I dont know how to get that in to something usable for the above script.

Thanks for any help
Steve

junho lee · Dec 29th 2010

Re: Unique word count from free text

Hi stevewhat,
Nice to meet you.
Add sheets "TextData" which has free data then.

Code

Option Explicit
Sub CntTxt()
    Dim dic As Object
    Dim varRange
    Dim objSheet As Worksheet
    Dim rCell As Range
    Dim i As Long, j As Long
    Set objSheet = Worksheets("Tag Cloud Visualization")
    Set rCell = objSheet.Range("B6:C6")
    Set dic = CreateObject("scripting.dictionary")
    varRange = Sheets("TextData").UsedRange
    For i = 1 To UBound(varRange, 1)
        For j = 1 To UBound(varRange, 2)
            If Not IsEmpty(varRange(i, j)) Then dic(varRange(i, j)) = dic(varRange(i, j)) + 1
        Next
    Next
    With Application
        rCell(1).Resize(dic.Count) = .Transpose(dic.keys)
        rCell(2).Resize(dic.Count) = .Transpose(dic.items)
        'rCell(2).Offset(dic.Count) = .Sum(rCell(2).Resize(dic.Count))
    End With
    'rCell(2).Offset(dic.Count).Copy
    'rCell(2).Resize(dic.Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlDivide, _
    '    SkipBlanks:=False, Transpose:=False
    'rCell(2).Offset(dic.Count).ClearContents
End Sub

Display More

Regards, junho

stevewhat · Dec 29th 2010

Re: Unique word count from free text

Thanks so much for helping junho! I am a complete n00b with VB so please bare with me

Ive implemented your script but when trying to run it I get this error: Runtime error '13': Type mismatch on this line:
rCell(1).Resize(dic.Count) = .Transpose(dic.Keys)

What have I done wrong?

junho lee · Dec 29th 2010

Re: Unique word count from free text

Hi stevewhat,
Try change

Code

rCell(1).Resize(dic.Count) = .Transpose(dic.Keys)

to

Code

rCell(1).Resize(dic.Count).Value = .Transpose(dic.Keys)

Regards, junho

stevewhat · Dec 29th 2010

Re: Unique word count from free text

Hey junho, still no joy.

Ive added a sample of the survey to this post. The results run to about 550 rows in Novembers data

junho lee · Dec 29th 2010

Re: Unique word count from free text

Hi stevewhat,
I can't duplicate 'type mismatch error',sorry.
Attatched I've tested.
Regards, junho

Unique word count from free text

Participate now!

Share