Microsoft Office Forums - View Single Post - [Solved] Finding,Sorting and creating a new Section VBA Script help

tonykekw · 01-24-2024, 06:18 PM

Hey I was playing around with the script you gave me and I was wondering if it can also harvest data in front of the search value. If the data in front of the value is a bullet list/number list and or multilevel list?

Code:

Sub GatherRound()
  Dim aRng As Range, aRngHead As Range, aDoc As Document, aDocNew As Document, aTbl As Table, aRow As Row
  Set aDoc = ActiveDocument
  Set aRng = aDoc.Range
  Set aDocNew = Documents.Add
  Set aTbl = aDocNew.Tables.Add(aDocNew.Range, 1, 2)
  aTbl.Cell(1, 1).Range.Text = "Heading"
  aTbl.Cell(1, 2).Range.Text = "Text"
  With aRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[Red]"
    .Forward = True
    Do While .Execute
      aRng.Start = aRng.Paragraphs(1).Range.Start
      Set aRow = aTbl.Rows.Add
      aRow.Cells(2).Range.FormattedText = aRng.FormattedText
      Set aRngHead = aRng.GoToPrevious(wdGoToHeading)
      aRngHead.End = aRngHead.Paragraphs(1).Range.End - 1
      aRow.Cells(1).Range.Text = aRngHead.ListFormat.ListString & vbTab & aRngHead.Text
      aRng.Collapse Direction:=wdCollapseEnd
      aRng.End = aDoc.Range.End
    Loop
  End With
End Sub

I was adding this:

Code:

' Check if the paragraph is part of a list
            If aRng.Paragraphs(1).Range.ListFormat.ListType <> wdListNoNumbering Then
                Set aListFormat = aRng.Paragraphs(1).Range.ListFormat
                aRow.Cells(1).Range.Text = aRow.Cells(1).Range.Text & " " & GetListText(aListFormat)