Word count in cell

Sub CountWords()
    Dim MyRange As Range
    Dim CellCount As Long
    Dim TotalWords As Long
    Dim NumWords As Integer
    Dim Raw As String


    Set MyRange = ActiveSheet.Range(ActiveWindow.Selection.Address)
    TotalWords = 0
    For CellCount = 1 To MyRange.Cells.Count
            If Not MyRange.Cells(CellCount).HasFormula Then
                Raw = MyRange.Cells(CellCount).Value
                Raw = Trim(Raw)
                If Len(Raw) > 0 Then
                    NumWords = 1
                Else
                    NumWords = 0
                End If
                While InStr(Raw, " ") > 0
                    Raw = Mid(Raw, InStr(Raw, " "))
                    Raw = Trim(Raw)
                    NumWords = NumWords + 1
                Wend
                TotalWords = TotalWords + NumWords
            End If
        Next CellCount
        MsgBox "There are " & TotalWords & " words in the selection."
End Sub