VBA code to count unique words in a range of cells

[scottyblaze]

Hello, I am trying to find a way to count the number of unique words in a range of cells when each cell contains numerous words. For example:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]The dog and the cat are asleep.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]The cat is inside.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]The dog is outside.[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]






I'm looking for a way to count the unique words in the above range, which should be 9 for "The, dog, and, cat, are, asleep, is, inside, outside". I've found formulas to count unique cells, but not unique words. Ideally, I want to put this into VBA so that all I would need to do is highlight a range and run the macro.

Is this possible? Can anyone offer some assistance?

Thanks.

 

[hiker95]

Old thread but i was wondering .. in relation to reply #4, the final sorted data in descending order does not take any number over 10+ as such but instead sorts it with 1

To clarify: 1,7,13,3,5 are being sorted as 1,13,3,5,7

Anyone know how to fix this within the VBA code provided?

Thank you

gaskind,

Welcome to the MrExcel forum.


So that we can get it right on the next try:


We would like more information. Please see the Forum Use Guidelines in the following link:

http://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html


See reply #2 at the next link, if you want to show small screenshots, of the raw data, and, what the results should look like.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729

 

[pbornemeier]

This code will sort the Output worksheet created in Post #4 with the words with the largest count to the top, and words with the same count in alphabetical order. Add it to teh same module as the Post #4 code.

Sub SortOutputByCountDescendingThenAlphabetically()

    Dim lLastRow As Long
    
    With Worksheets("Output")
         lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("B2:B" & lLastRow), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("A2:A" & lLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets("Output").Range("A1:B" & lLastRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
End Sub

Add the red line to the code at the end of the 'Test_ReturnUniqueWordsAndCountsInSelectedRanges' sub as shown:

    Worksheets(sWorksheet).Range("A2").Resize(UBound(x, 2), 2).Value = Application.Transpose(x)
    [COLOR="#FF0000"]SortOutputByCountDescendingThenAlphabetically[/COLOR]
End_Sub: