Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim oCol As New Collection
Dim lngIndex As Long
Dim oRng As Word.Range
Dim oRow As Row
Dim lngCell As Long
  Set oTbl = ActiveDocument.Tables(1)
  For Each oRow In oTbl.Rows
    If Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2) = "High" Then
      oCol.Add oRow
    End If
  Next oRow
  Set oRng = ActiveDocument.Bookmarks("bmRows").Range
  If oRng.Tables.Count = 1 Then
    oRng.Tables(1).Delete
  End If
  Set oTbl = oRng.Tables.Add(oRng, oCol.Count, 3)
  For lngIndex = 1 To oCol.Count
    For lngCell = 1 To oCol(lngIndex).Range.Cells.Count
      oTbl.Rows(lngIndex).Cells(lngCell).Range.Text = Left(oCol(lngIndex).Cells(lngCell).Range.Text, _
          Len(oCol(lngIndex).Cells(lngCell).Range.Text) - 2)
    Next
  Next
  ActiveDocument.Bookmarks.Add "bmRows", oTbl.Range
End Sub