Word count as I type into a text box

[constantG]

Hi, I am trying to utilise this module to count words in a text box. The example shows how many words but only After update of the text box. How can I get it to show the word count as words are typed into the text box?

All help appreciated.

Thanks

 

[vbaInet]

I don't know what the code looks like but I assume it works. Just move the function from the After Update event to the Change event.

 

[constantG]

My apologies for only making it a link. here's the code that I am using and but it only updates on the first keypress or when the text initially changes but after that I've noticed that it doesn't call the procedure at all.

txtWordCount is a text box in the form.

Private Sub txtText_Change()
 
      Me.txtWordCount = WordCount(Me.txtText)
 
End sub

Option compare database
Option explicit
Public strSplitString() As String
 
Public Function SplitString(inputstr) As String
 
    Dim intX As Integer
    ReDim strSplitString(1) 'Start with 1 element
 
        inputstr = Trim(inputstr)
        'Get rid of any double spaces
        While InStr(inputstr, "  ") > 0
            inputstr = Left(inputstr, InStr(inputstr, "  ") - 1) & Mid(inputstr, InStr(inputstr, "  ") + 2)
            'NB the " " contains TWO spaces in the above lines
        Wend
        'Create an array with each chunk of string
        intX = 0
        inputstr = inputstr & " "
        While InStr(inputstr, " ") > 0
             strSplitString(intX) = Left(inputstr, InStr(inputstr, " ") - 1)
             inputstr = Mid(inputstr, InStr(inputstr, " ") + 1)
             'NB the " " contains ONE space in the above lines
             intX = intX + 1
             ReDim Preserve strSplitString(intX)
        Wend
    ReDim Preserve strSplitString(intX - 1) 'Resize array to number of elements
 
End Function
 
 
 
Function WordCount(inputstr) As Long
 
    If IsNull(inputstr) Then 
        WordCount = 0
    Else
        SplitString (inputstr)
        WordCount = UBound(strSplitString) + 1
    End If
 
End Function

I have also put the call in the Forms KeyPress event and the text box's KeyPress event to no avail.

Thanks

 

[stopher]

You need to change the On change event to this:

Private Sub txtText_Change()
 
      Me.txtWordCount = WordCount(Me.txtText[COLOR="Red"].text[/COLOR])
 
End sub

Also, I'm sure the code you have works but it seems a bit heavy. Try this (just one function):

Function WordCount(inputstr) As Long
Dim a() As String
Dim varWord As Variant
a = Split(inputstr, " ")
WordCount = 0
For Each varWord In a
    If Len(varWord) > 0 Then
        WordCount = WordCount + 1
    End If
Next varWord
End Function

hth
Chris

 

[constantG]

After a bit of digging around I have found this

Private Sub txtText_Change()
 
    If IsNull(Me.txtText) Then
        
        Me.txtWordCount = 0
        Exit Sub
    Else
    
        Me.txtWordCount = Len(Me.txtText) - Len(Replace(Me.txtText, " ", "")) + 1
    End If

End Sub

which works just as well but it still doesn't update as I am typing.

 

[constantG]

Re: Word count as I type into a text box (SOLVED)

Solved

Private Sub txtText_Change()
    If Not IsNull(Me.txtText) Then
        Me.txtWordCount = Len(Me.txtText.Text) - Len(Replace(Me.txtText.Text, " ", "")) + 1
        
    Else
        Me.txtWordCount = 0
        
        
    End If
End Sub

Thanks.

 

[stopher]

There are some problems with your code. First of all you still need me.txtText.text in the first line.

The second problem is that your code counts spaces with the assumption that the number of words must be 1 greater than the number of space. But this is not necessarily the case. The user could easily type two spaces. Also the user could put a space at the beginning or end. So as soon as the user finishes the first word and hits the space key, the code thinks there are two words.

Chris

 

[constantG]

Apologies to you Stopher, I work quickly at trying to solve these problems, and the solution that I have found is perfect for my needs.

Thanks for your input.

 

[constantG]

Agreed, I will use yours so that extra spaces are discounted.
Thanks again.

 

[vbaInet]

The function may not cope well with multiline values. Test it out.

Here's an alternative:

Public Function WordCount(strWords As Variant) As Long
    If IsNull(strWords) Then
        WordCount = 0
        Exit Function
    End If
    
    RE.Global = True: RE.Multiline = True
    
    RE.Pattern = "\S+"
    Set REMatches = RE.Execute(strWords)
    
    WordCount = REMatches.Count
End Function

Declare the objects in the declarations section of your form:

Option Compare Database
Option Explicit

Private RE As Object, REMatches As Object

On the form's Load event:

    Set RE = CreateObject("vbscript.regexp")

On the form's Unload event:

    Set RE = Nothing
    Set REMatches = Nothing

 

[Galaxiom]

Apologies to you Stopher, I work quickly at trying to solve these problems, and the solution that I have found is perfect for my needs.

Much time has been wasted and many a bug has surfaced later through thoughtless cut and pasting code without fully considering its suitablitiy and vulnerabilities.

There is a lot of published code that is far from ideal, especially when used outside its original context.

If I recall correctly, the Commandments include Thou shalt not cut and paste code that is not fully understood.

 

[constantG]

I've removed the "Solved" tag in the title of this as I need the code to do a little more.

The code I originally had counted characters as they were input and using a key_press and key_change event I could limit the users input to a specific amount of characters. Here's the code I used:

Sub LimitKeyPress(ctl As Control, iMaxLen As Integer, KeyAscii As Integer)
On Error GoTo Err_LimitKeyPress
    ' Purpose:  Limit the text in an unbound text box/combo.
    ' Usage:    In the control's KeyPress event procedure:
    '             Call LimitKeyPress(Me.MyTextBox, 12, KeyAscii)
    ' Note:     Requires LimitChange() in control's Change event also.

    If Len(ctl.Text) - ctl.SelLength >= iMaxLen Then
        If KeyAscii <> vbKeyBack Then
            KeyAscii = 0
            Beep
        End If
    End If

Exit_LimitKeyPress:
    Exit Sub

Err_LimitKeyPress:
    Call LogError(Err.Number, Err.Description, "LimitKeyPress()")
    Resume Exit_LimitKeyPress
End Sub
Sub LimitChange(ctl As Control, iMaxLen As Integer)
On Error GoTo Err_LimitChange
    ' Purpose:  Limit the text in an unbound text box/combo.
    ' Usage:    In the control's Change event procedure:
    '               Call LimitChange(Me.MyTextBox, 12)
    ' Note:     Requires LimitKeyPress() in control's KeyPress event also.

    If Len(ctl.Text) > iMaxLen Then
        MsgBox "Truncated to " & iMaxLen & " characters.", vbExclamation, "Too long"
        ctl.Text = Left(ctl.Text, iMaxLen)
        ctl.SelStart = iMaxLen
    End If

Exit_LimitChange:
    Exit Sub

Err_LimitChange:
    Call LogError(Err.Number, Err.Description, "LimitChange()")
    Resume Exit_LimitChange
End Sub

How would I do this, limiting the number of words to 120?

Thanks.

 

[vbaInet]

It would be beneficial to others if you created a new thread for this new requirement. This isn't related to word count. Once you've done that you can point us to that thread.