Count Words in cell and ignore blanks

[cpmurray1985]

Hello,

I am trying to create a word/phrase counter where it counts the contents of the cell (regardless of how many words are in there), and shows how many times it appears in the range. I apologize if it sounds confusing, but here is the example:

Source:

Genre	Number
Historical Fantasy	xxxxx
Historical Fantasy
Comedy	yyyy
Non-Fiction	zzzz

Expected Result:

Genre	Number	Phrase/Word	How many times?
Historical Fantasy	xxxxx	HISTORICAL FANTASY	2
Historical Fantasy		COMEDY	1
Comedy	yyyy	NON-FICTION	1
Non-Fiction	zzzz

However, when I run the macro, it comes out like this instead, where it separates 'Historical Fantasy' into two words instead (because of the space between them) of just how it appears in its own cell, and may not even show 'Non-Fiction' as it has a special character.

Genre	Number	Phrase/Word	How many times?
Historical Fantasy	xxxxx	HISTORICAL	2
		FANTASY	2
Historical Fantasy		COMEDY	1
Comedy	yyyy
Non-Fiction	zzzz

In addition, I have other worksheets (over 50+) that contains the column Number only (It is filtered by genre, example would be worksheet 1 is called Historical Fantasy, worksheet 2 is called Comedy, etc), but there are times the genre does not have a number at all.

If I run the macro (I have it so it is going across all worksheets) and there is a mix of values in Number Column and blanks in a worksheet, it will run just fine and display the number of times, for example, xxxxx appears. However, if there is a separate worksheet that contains no values at all, or is just completely blank in the Number column, it will run a 'mismatch 13 error' and stop all together, not even going to the remaining worksheets that contain values in the Number Column. So it might complete 5 worksheets out of 50, as worksheet 6 might have no values in the Number Columns, but worksheets 7-16, 20-35, 43-50, for example, might have values.

I have the code below (not mine, it was in another thread but I cannot seem to find it anymore to reference), they are the same for both, with the exception the function name and range changes.

Sub WordCount()

Dim arr As Variant, a As Long, cel As Range

With CreateObject("Scripting.Dictionary")

For Each cel In Range("G2", Cells(Rows.Count, "G").End(xlUp))

arr = Split(cel.Value, " ")

For a = LBound(arr) To UBound(arr)

.Item(UCase(arr(a))) = .Item(UCase(arr(a))) + 1

Next a

Next cel

Range("S2").Resize(.Count) = Application.Transpose(.Keys)

Range("T2").Resize(.Count) = Application.Transpose(.items)

Range("S2").Resize(.Count, 2).Sort Key1:=Range("T2"), Order1:=2, Key2:=Range("S2"), Order2:=1

End With

End Sub

Thank you in advance.

 

[DanteAmor]

I have the code below (not mine, it was in another thread but I cannot seem to find it anymore to reference), they are the same for both, with the exception the function name and range changes.

So, in which column do you have the genres? In which column you want the results?

If this is the result you want, then only the genre column should be considered.

 

[cpmurray1985]

So, in which column do you have the genres? In which column you want the results?

If this is the result you want, then only the genre column should be considered.

View attachment 60086

I have it in G, and when I run the macro, it does not come out as the expected result.

It seems to separate the words (such as Historical Fantasy becomes "History", "Fantasy") if there is a space between them.

 

[DanteAmor]

The following code works for all sheets, no matter if column G is empty or a single record.
Count by phrase and not by each word.
Test and comment.

Sub Count_Words()
  Dim sh As Worksheet
  Dim dic As Object
  Dim a() As Variant
  Dim i As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  
  For Each sh In Sheets
    Erase a
    dic.RemoveAll
    a = sh.Range("G2:G" & sh.Range("G" & Rows.Count).End(3).Row + 2).Value
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "" Then dic(a(i, 1)) = dic(a(i, 1)) + 1
    Next
    If dic.Count > 0 Then
      With sh.Range("S2").Resize(dic.Count, 2)
        .Value = Application.Transpose(Array(dic.keys, dic.items))
        .Sort sh.Range("T2"), 2, sh.Range("S2"), , 1
      End With
    End If
  Next
End Sub

 

[cpmurray1985]

The following code works for all sheets, no matter if column G is empty or a single record.
Count by phrase and not by each word.
Test and comment.

Sub Count_Words()
  Dim sh As Worksheet
  Dim dic As Object
  Dim a() As Variant
  Dim i As Long
 
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
 
  For Each sh In Sheets
    Erase a
    dic.RemoveAll
    a = sh.Range("G2:G" & sh.Range("G" & Rows.Count).End(3).Row + 2).Value
    For i = 1 To UBound(a, 1)
      If a(i, 1) <> "" Then dic(a(i, 1)) = dic(a(i, 1)) + 1
    Next
    If dic.Count > 0 Then
      With sh.Range("S2").Resize(dic.Count, 2)
        .Value = Application.Transpose(Array(dic.keys, dic.items))
        .Sort sh.Range("T2"), 2, sh.Range("S2"), , 1
      End With
    End If
  Next
End Sub

Thank you so much, this code does exactly what I needed it to do!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.