counting words

How can I count words in a text box? I know that if I use len(text1) I can get the count of all the charaters, but I would like to find the amount of words.

Thanks

Simple as pie:

Code:

---

Dim SpaceCount As Long

For x = 1 To Len(Text1.Text)
 If Mid(Text1.Text, x, 1) = " " Then SpaceCount = SpaceCount + 1
Next x

---

Mind you if there are 2 spaces in a row it will count as 2 words. I'm too lazy to find a way around this.

Your code is to slow Dreamlax. Better use this:

Code:

---

Dim WordsCount() As String 'Dim it as an array

WordsCount = Split(Text1.Text, " ")
Call MsgBox("There are " & UBound(WordsCount) + 2 & " words in your text!")

---

It's a littlebit easier and faster :)

WP

Hey, I'm a slow person! he he he.

I suppose my code was too slow, but I'm not that much of a programmer.

hmm.. Dreamlax, your code may be slow, but it can be used with VB5, WP's not since it uses split, you can ofcourse use a substitute for the split function, but that would affect the readability.

I don't know but maybe this one is faster:

Code:

---

Private Function Words(Src$)
Dim x%, p&
x = 1
Src = Trim(Src)
If Len(Src) = 0 Then x = 0

p = InStr(1, Src, " ")

Do While p <> 0
    p = InStr(p + 1, Src, " ")
    x = x + 1
Loop

Words = x
End Function

---

[Edited by Jop on 11-19-2000 at 08:55 AM]

WP's code worked very well. I thank you all for posting. And since I have VB6, I don't care that it doesn't work in VB5. I tried all the code though, and all of it worked, except dreamlax's. It didn't lower the count if you deleted words. Thanks again.

MidgetsBro

Hi Jop,
You actually don't really need the first instr line. Without it, p would automatically start at one since you are also incrementing by 1.

Code:

---

Private Function f_WordCount(str_Word As String) As Integer
  str_Word = Trim(str_Word)
  If Len(str_Word) = 0 Then Exit Function
 
  Dim int_X As Integer
  Dim int_Pos As Integer
 
  Do
      int_Pos = InStr(int_Pos + 1, str_Word, " ")
      If int_Pos = 0 Then Exit Do
      int_X = int_X + 1
  Loop
 
  f_WordCount = int_X
End Function

---

'here's a wrench in the gears...try this

Code:

---

Private Sub Command1_Click()

Dim WordsCount() As String 'Dim it as an array

    WordsCount = Split(Text1.Text, " ")
    Call MsgBox("There are " & UBound(WordsCount) + 2 & " words in your text!")
End Sub

Private Sub Form_Load()
    Text1 = "Help me  out  here!"
End Sub

---

That is similar to what WP posted.

Nitro: he is pointing out that if you have more than one space in a row, it counts as a word.

try it..it isn't code that works,it is code that shows you that all code posted so far is inaccurate..none of it works.

I didn't think mine would work. About 1% of the time I actually write the code SO well that it works. The other 99% is just code to be fixed. I don't think anyone has written a program and never stumbled accross any errors, unless it was just a form with a button that beeps. Or a 'hello world' program. Or maybe one that closes as soon as it opens.

Hey sorry, I misunderstood.

It's no reflection on anyone's ability....just simply pointing out that there is one obstacle to overcome in counting words and I don't have the answer or I'd post it.

Code:

---

Private Function f_WordCount(str_Word As String) As Integer
  str_Word = Trim(str_Word)
  If Len(str_Word) = 0 Then Exit Function
 
  Dim int_X As Integer
  Dim int_Pos As Integer
  Dim int_Last As Integer
  Do
      int_Pos = InStr(int_Pos + 1, str_Word, " ")
      If int_Pos = 0 Then Exit Do
      If int_Last + 1 <> int_Pos Then int_X = int_X + 1
      int_Last = int_Pos
  Loop
 
  f_WordCount = int_X + 1
End Function

---

[Edited by Nitro on 11-19-2000 at 06:20 PM]

first test gives it a GreenLight...a OK

Fails on the second test. 36 and your function gives 34

Text1 = "This is a test. There's lots of weird stuff in here. Like....separating words with stuff other than blanks:" & vbCrLf & "line feeds and so on. It also contains consecutive blanks. It needs to handle all of these!!!"

Code:

---

'I didn't write this I found it but it seems to do the trick.

Private Sub Command1_Click()

'Calculates the number of words in a string.

Dim strTest As String
Dim lngLen As Long
Dim lngPos As Long
Dim lngCount As Long


strTest = Text1
'let's break this down the way we humans would do it....
'This _
 is _
 a _
 test _
 There's _
 lots _
 of _
 weird _
 stuff _
 in _
 here _
 Like _
 separating _
 words _
 with _
 stuff _
 other _
 than _
 blanks _
 line _
 feeds _
 and _
 so _
 on _
 It
'also _
 contains _
 consecutive _
 blanks _
 It _
 needs _
 to _
 handle _
 all _
 of _
 these

'36 words...

'Code:
lngLen = Len(strTest)

lngPos = 1
lngCount = 0
Do While lngPos <= lngLen
    Debug.Print Mid(strTest, lngPos, 1)
    If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'", Mid(strTest, lngPos, 1)) > 0 Then
        lngPos = lngPos + 1
    Else
        lngCount = lngCount + 1
        Do While lngPos <= lngLen
            If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'", Mid(strTest, lngPos, 1)) > 0 Then
                Exit Do
            End If
            lngPos = lngPos + 1
        Loop
    End If
Loop

MsgBox lngCount

End Sub

Private Sub Form_Load()
    Text1 = "Help me  out  here!"
End Sub

---

Who ever thought counting words would be so hard? (9)

:D In a perfect world it wouldn't.

In a perfect world, we would have code where you just say what you want it to do:

Code:

---

Bring up a message box saying "hello world" with two buttons, OK and Cancel.

Then using the PC's internal speaker, beep 10 times.

Now Eject the CD and beep 2 more times.

---

Imagine code like that!

There's an easy way out though..

Code:

---

Function Wordcount(Text As String) As Long
    Dim words() As String, x&, n&, max&
    If Len(Text) Then
        words = Split(Text)
        n = UBound(words)
        For x = 0 To n
            If words(x) = vbNullString Then n = n - 1
        Next x
        Wordcount = n + 1
    End If
End Function

---

kedaman:
your's returns 34 as well..not quite correct.
There are 36 words in the string.

strWord ="This is a test. There's lots of weird stuff in here. Like....separating words with stuff other than blanks:" & vbCrLf & "line feeds and so on. It also contains consecutive blanks. It needs to handle all of these!!!"

So you want to do it the hard way? Well it's slow but a sure way to keep out any non-word characters. I did something to speed up the procedure:

Code:

---

Private AT() As Byte

Static Function Wordcount(text As String)
    Dim a() As Byte, x&, nonword As Boolean
    a = StrConv(text, vbFromUnicode)
    nonword = True
    For x = 0 To UBound(a)
        If AT(a(x)) Then
            If nonword Then
                Count = Count + 1
            End If
            nonword = False
        Else
            nonword = True
        End If
    Next x
    Wordcount = Count
End Function


Private Function ASCIITable(Typein As String) As Byte()
    Dim a() As Byte, b(255) As Byte, n&
    If Len(Typein) Then
        a = StrConv(Typein, vbFromUnicode)
        For n = 0 To UBound(a)
            b(a(n)) = 1
        Next n
    End If
    ASCIITable = b
End Function
Sub init()
    AT = ASCIITable("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'")
End Sub

---

The Asciitable function returns a lookup table for the wordcount function to use.

I knew you could do it...I'll file away this revised edition in case I ever want to count the words in the dictionary or something.

:D