counting words

[MidgetsBro]

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:

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.

[WP]

Your code is to slow Dreamlax. Better use this:

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.

[Jop]

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:

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]

[MidgetsBro]

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

[Nitro]

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.

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

[HeSaidJoe]

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

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

[Nitro]

That is similar to what WP posted.

[MidgetsBro]

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

[HeSaidJoe]

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.

[Nitro]

Hey sorry, I misunderstood.

[HeSaidJoe]

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.

[Nitro]

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]

[HeSaidJoe]

first test gives it a GreenLight...a OK

[HeSaidJoe]

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!!!"

[HeSaidJoe]

'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)

[HeSaidJoe]

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:

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!

[kedaman]

There's an easy way out though..

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

[HeSaidJoe]

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!!!"

[kedaman]

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:

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.

[HeSaidJoe]

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.