Microsoft Office Forums - View Single Post - How can I tag and selectively extract text (multiple files)?

gmayor · 10-29-2014, 10:29 PM

I saw this question earlier, but couldn't find it when I returned to reply, and assumed it was in another forum that was down at the time. However I had worked out a simple macro solution that should do what you ask.

The following will count the words in paragraphs that start with a time in square brackets as shown followed by two or more initials. The result is displayed in a message box. When the macro is run the input box is not case sensitive.

Code:

Option Explicit
Sub WordsFromSpeaker()
Dim oRng As Range
Dim oPara As Paragraph
Dim strSpeaker As String
Dim strFirstWord As String
Dim lng_speaker As Long
Dim lng_Count As Long
    lng_Count = 0
    strSpeaker = UCase(InputBox("Enter speaker's initials", "Count Words", "LW"))
    For Each oPara In ActiveDocument.Paragraphs
        strFirstWord = ""
        Set oRng = oPara.Range
        oRng.MoveStartUntil "]"
        oRng.Start = oRng.Start + 1
        oRng.Collapse 1
        oRng.MoveEndUntil Chr(32)
        If Trim(oRng.Text) = Trim(strSpeaker) Then
            Set oRng = oPara.Range
            oRng.MoveStartUntil "]"
            oRng.Start = oRng.Start + Len(strSpeaker) + 2
            oRng.End = oRng.End - 1
             lng_Count = lng_Count + CountWords(oRng.Text)
        End If
    Next oPara
    MsgBox strSpeaker & Chr(32) & lng_Count & " words"
End Sub

Private Function CountWords(strText As String) As Long
Dim vWords As Variant
Dim strFirst As String
Dim i As Long
    vWords = Split(strText)
    For i = LBound(vWords) To UBound(vWords)
        strFirst = UCase$(Left$(vWords(i), 1))
        If strFirst Like "[A-Z]" Then
            CountWords = CountWords + 1
        End If
    Next i
End Function