Excel doesn’t know how to count words, at least for the 2023 current version, to tell you how many words there are in a cell, excel counts the number of spaces. Since this article is about using VBA, I don’t talk to much about formula but if you look in internet, all formula that you will find, they have a “+1” at the end. For instance, “tell me”, there is one space so counting the space + 1 = 2 words.

Even here in which I am telling you how to count them using a macro, the code has “+1” at the final:

• UBound(Split(xxx)) + 1

NOTE: xxx is your cell reference

But it may happen that “ubound” is not giving me the result I want, so alternatively, I am using “len” to count the number of characters:

• Len(xxx) or Len(Trim(xxx)) -> count all characters including spaces
• Len(Replace(Trim(xxx), " ", "")) -> count all characters without spaces

NOTE: in case words are separated by a comma for example, just replace " " by ","

For instance, “tell me”:

• With the first code, the result will be 7 characters
• With the second code, the result will be 6 characters

So combining both to count the number of words:

• Len(xxx) - Len(Replace(Trim(xxx), " ", "")) + 1

NOTE: Len(xxx) can be replaced by Len(Trim(xxx)). In some situation, it works better.

Going back to the main purpose of my article, this VBA will count the number of words for each cell and I will explain more actions like adding new rows for each cell with more than 1 word, splitting the words into those new rows, etc.

 

When I use the macro ?

When I have to count number of words per cell and split them to new rows.

 

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

 

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

 

How is/are the macro(s) ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

To count only words:

Sub test()
Dim SrchRng As Long
' change C by your column
SrchRng = Cells(Rows.Count, "C").End(xlUp).Row
For Each Cell In Range("C2:C" & SrchRng) 
  ' to count empty cells, change >= 1 by >= 0
  If UBound(Split(Cell)) + 1 >= 1 Then
    ' remove this line if dont want the popup
    MsgBox UBound(Split(Cell)) + 1
    ' change 3 by the column where you want to put the result
    ' i.e. 3 from column C = F
    ' remove this line if dont want the result in column
    Cell.Offset(0, 3) = UBound(Split(Cell)) + 1
  End If
Next Cell
End Sub              
              

Doing more things:

Sub test()
Dim SrchRng As Long
Dim SplitCell() As String
' change C by your column
SrchRng = Cells(Rows.Count, "C").End(xlUp).Row
For Each Cell In Range("C2:C" & SrchRng) 
  ' to count empty cells, change >= 1 by >= 0
  If UBound(Split(Cell)) + 1 > 1 Then
    Cell.Offset(1).Resize(UBound(Split(Cell))).EntireRow.Insert
    ' change 1 and 2 by the column to copy/paste
    ' i.e. 1 from column C = D and 2 from column C = E
    Range(Cell.Offset(0, 1), Cell.Offset(0, 2)).Copy Cell.Offset(0, 1).Resize(UBound(Split(Cell)) + 1) 
    ' change -2 and -1 by the column to copy/paste from column C
    ' i.e. -2 from column C = A and -1 from column C = B
    Range(Cell.Offset(0, -2), Cell.Offset(0, -1)).Copy Cell.Offset(0, -2).Resize(UBound(Split(Cell)) + 1) 
    ' split each word into new row
    ' if words are separated with coma space, change " " by ", "
    SplitCell = Split(Cell, " ")
    For i = 0 To UBound(SplitCell) 
      Cell.Offset(i, 0).Value = SplitCell(i) 
    Next i
  End If
Next Cell
End Sub              
              

To count only unique words:

Sub test()
Dim SrchRng As Long
Dim Tmp As Variant
Dim i As Long
' change C by your column
SrchRng = Cells(Rows.Count, "C").End(xlUp).Row
With CreateObject("scripting.dictionary")
  For Each Cell In Range("C2:C" & SrchRng) 
  ' to count empty cells, change >= 1 by >= 0
    If UBound(Split(Cell)) + 1 >= 1 Then
      Tmp = Split(Cell) 
      For i = 0 To UBound(Tmp) 
        .Item(Tmp(i)) = .Item(Tmp(i)) + 1
      Next i
      ' change 3 by the column where you want to put the result
      ' i.e. 3 from column C = F
      Cell.Offset(0, 3) = .Count
      .RemoveAll
    End If
  Next Cell
End With
End Sub