none
Nothing New Under the Sun RRS feed

  • Question

  • I edit very long documents to pay light bills.  I use MS Word 2013.  I'm looking for VBA code to count words, but not punctuation marks (. , ; : )and other unusual characters & # in each sentence, then insert comment "Your sentence is over 50 words, please rewrite" for each sentence.

    I poached this while wandering in the desert.  It works to agree:

    Sub LongSentences1()
    '
    ' LongSentences1 Macro
    '
    'Sub Mark_Long()
        Dim iMyCount As Integer
        Dim iWords As Integer

        If Not ActiveDocument.Saved Then
            ActiveDocument.Save
        End If

        'Reset counter
        iMyCount = 0

        'Set number of words
        iWords = 50

        For Each MySent In ActiveDocument.Sentences
            If MySent.Words.Count > iWords Then
                MySent.Font.Color = wdColorRed
                iMyCount = iMyCount + 1
            End If
        Next
        MsgBox iMyCount & " sentences longer than " & _
          iWords & " words."
    End Sub

    It will count words, but this count includes non words, e.g. "." "?" ":", you get the picture.....

    I searched high and low but found nothing to exclude non words.

    Feedback greatly appreciated, code edits or pointer to another church.

    Thanks

    Thursday, July 30, 2015 12:25 PM

Answers

  • Try it like this, which removes anything that is not a-z or a space before figuring out the length.

    Sub LongSentences2()
        Dim iMyCount As Integer
        Dim iWords As Integer
        Dim strSent As String
        Dim mySent As Range

        If Not ActiveDocument.Saved Then
            ActiveDocument.Save
        End If

        'Set number of words
        iWords = 50

        For Each mySent In ActiveDocument.Sentences
            strSent = CleanSentence(mySent.Text)
            If Len(strSent) - Len(Replace(strSent, " ", "")) >= iWords Then
                mySent.Font.Color = wdColorRed
                iMyCount = iMyCount + 1
            End If
        Next
        
        MsgBox iMyCount & " sentences longer than " & _
          iWords & " words."
    End Sub

    Function CleanSentence(strS As String) As String
        Dim i As Integer
        
        For i = 1 To Len(strS)
            If Mid(strS, i, 1) = " " And Len(CleanSentence) > 0 Then
                If Right(CleanSentence, 1) <> " " Then
                    CleanSentence = CleanSentence & " "
                End If
            End If
            If (Asc(UCase(Mid(strS, i, 1))) >= 65 And Asc(UCase(Mid(strS, i, 1))) <= 90) Then
                CleanSentence = CleanSentence & Mid(strS, i, 1)
            End If
        Next i
    End Function

    Thursday, July 30, 2015 5:13 PM

All replies

  • Try it like this, which removes anything that is not a-z or a space before figuring out the length.

    Sub LongSentences2()
        Dim iMyCount As Integer
        Dim iWords As Integer
        Dim strSent As String
        Dim mySent As Range

        If Not ActiveDocument.Saved Then
            ActiveDocument.Save
        End If

        'Set number of words
        iWords = 50

        For Each mySent In ActiveDocument.Sentences
            strSent = CleanSentence(mySent.Text)
            If Len(strSent) - Len(Replace(strSent, " ", "")) >= iWords Then
                mySent.Font.Color = wdColorRed
                iMyCount = iMyCount + 1
            End If
        Next
        
        MsgBox iMyCount & " sentences longer than " & _
          iWords & " words."
    End Sub

    Function CleanSentence(strS As String) As String
        Dim i As Integer
        
        For i = 1 To Len(strS)
            If Mid(strS, i, 1) = " " And Len(CleanSentence) > 0 Then
                If Right(CleanSentence, 1) <> " " Then
                    CleanSentence = CleanSentence & " "
                End If
            End If
            If (Asc(UCase(Mid(strS, i, 1))) >= 65 And Asc(UCase(Mid(strS, i, 1))) <= 90) Then
                CleanSentence = CleanSentence & Mid(strS, i, 1)
            End If
        Next i
    End Function

    Thursday, July 30, 2015 5:13 PM
  • This works perfectly!

    You Sir are a VBA virtuoso!

    Thanks

    Friday, July 31, 2015 1:50 PM
  • Great - thanks for letting me know.
    Friday, July 31, 2015 3:54 PM