locked
macro to grab sentences in a document RRS feed

  • Question

  • Hi,

    I don't know if what I want is possible (fingers crossed). What I need is a macro that will search a word document for two words (must and shall), and when it finds those words, copy the sentence that it appears in, and pastes it into a table along with the page number that the sentence is on. I already have a macro that does a great job finding both words and giving me a table with the page number, I just can't figure out how (and if it's possible) to give me the actual sentence. Any ideas would be greatly appreciated!! Thank you in advance!!

    Saturday, November 29, 2014 6:56 PM

Answers

  • As advised in this thread: https://social.technet.microsoft.com/Forums/office/en-US/228d49ed-53a4-487f-9829-316f76abbe13/need-word-macro-to-make-list-of-defined-terms?forum=word#1c042f81-41a4-4c11-b1f6-4cc50c510dbf yesterday, VBA has no idea what a grammatical sentence is. Subject to that limitation, you could use something like:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrOut As String, i As Long, Rng As Range
    StrOut = "Sentences with 'must'" & vbTab & "page": i = 2
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Text = "must"
        .Replacement.Text = ""
        .Execute
      End With
      Do While .Find.Found
        i = i + 1
        StrOut = StrOut & vbCr & .Sentences.Last.Text & vbTab & _
          .Information(wdActiveEndAdjustedPageNumber)
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
      StrOut = StrOut & vbCr & "Sentences with 'shall'" & vbTab & "page"
      .Start = ActiveDocument.Range.Start
      With .Find
        .Text = "shall"
        .Replacement.Text = ""
        .Execute
      End With
      Do While .Find.Found
        StrOut = StrOut & vbCr & .Sentences.Last.Text & vbTab & _
          .Information(wdActiveEndAdjustedPageNumber)
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    StrOut = Replace(Replace(StrOut, Chr(12), ""), vbCr & vbTab, vbTab)
    Set Rng = ActiveDocument.Range
    With Rng
      .Collapse wdCollapseEnd
      .Text = StrOut
      .ConvertToTable vbTab
      With .Tables(1)
        With .Rows(1)
          .HeadingFormat = True
          .Range.Font.Bold = True
        End With
        .Split i
      End With
      With .Tables(2)
        With .Rows(1)
          .HeadingFormat = True
          .Range.Font.Bold = True
        End With
      End With
    End With
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by Alexandra VH Sunday, November 30, 2014 5:23 PM
    Sunday, November 30, 2014 5:04 AM

All replies

  • Do you want sentences in which both 'must' and 'shall' occur, or sentences in which at least one of those words occurs?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, November 29, 2014 7:32 PM
  • As advised in this thread: https://social.technet.microsoft.com/Forums/office/en-US/228d49ed-53a4-487f-9829-316f76abbe13/need-word-macro-to-make-list-of-defined-terms?forum=word#1c042f81-41a4-4c11-b1f6-4cc50c510dbf yesterday, VBA has no idea what a grammatical sentence is. Subject to that limitation, you could use something like:

    Sub Demo()
    Application.ScreenUpdating = False
    Dim StrOut As String, i As Long, Rng As Range
    StrOut = "Sentences with 'must'" & vbTab & "page": i = 2
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Text = "must"
        .Replacement.Text = ""
        .Execute
      End With
      Do While .Find.Found
        i = i + 1
        StrOut = StrOut & vbCr & .Sentences.Last.Text & vbTab & _
          .Information(wdActiveEndAdjustedPageNumber)
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
      StrOut = StrOut & vbCr & "Sentences with 'shall'" & vbTab & "page"
      .Start = ActiveDocument.Range.Start
      With .Find
        .Text = "shall"
        .Replacement.Text = ""
        .Execute
      End With
      Do While .Find.Found
        StrOut = StrOut & vbCr & .Sentences.Last.Text & vbTab & _
          .Information(wdActiveEndAdjustedPageNumber)
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    StrOut = Replace(Replace(StrOut, Chr(12), ""), vbCr & vbTab, vbTab)
    Set Rng = ActiveDocument.Range
    With Rng
      .Collapse wdCollapseEnd
      .Text = StrOut
      .ConvertToTable vbTab
      With .Tables(1)
        With .Rows(1)
          .HeadingFormat = True
          .Range.Font.Bold = True
        End With
        .Split i
      End With
      With .Tables(2)
        With .Rows(1)
          .HeadingFormat = True
          .Range.Font.Bold = True
        End With
      End With
    End With
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    • Marked as answer by Alexandra VH Sunday, November 30, 2014 5:23 PM
    Sunday, November 30, 2014 5:04 AM
  • Hello Alexandra VH,

    That is totally possible in any language that can interact with Office. Visual Basic for Applications (VBA) can do that. You only need to come up with the code. It would be a great exercise for you to learn VBA and solve this in about a week. I can do it and so should you!


    Best regards George

    Sunday, November 30, 2014 12:52 PM
  • Either instance. I have to shred requirements documents, is what I need it for...and doing it by the old "search" method can take days on long documents and not always be accurate.
    Sunday, November 30, 2014 5:20 PM
  • Paul, this is absolutely perfect!!! Thank you SO much. This will do exactly what I would like it to do. You are a lifesaver, and I owe you tremendously!!
    Sunday, November 30, 2014 5:23 PM