Microsoft Office Forums - View Single Post - Keeping just the rows with specific word (BUT KEEP THE TITLE)

Guessed · 05-29-2017, 07:03 PM

The majority of the code slowness is due to the screen updating and repagination as the code runs. We can turn that off while the code is running but I've taken the cheats way out and just moved the selection to the top of the document so all the changes take place off screen. I've also tightened the code to keep your heading rows and only look in the second column.

Code:

Sub HideUnwantedRows4()
  Dim sText As String, aTbl As Table, aHL As Hyperlink, aCell As Cell
  Dim iRow As Integer, aRng As Range, aRngTgt As Range, aRow As Row
  Dim sRefs As String, aRowRng As Range, sTag As String, bHit As Boolean
  
  ActiveDocument.Range.Font.Hidden = False
  sText = InputBox("What text are you searching for?")
  Selection.HomeKey Unit:=wdStory, Extend:=wdMove
  
  For Each aTbl In ActiveDocument.Tables
    If aTbl.Range.Paragraphs(1).Style = "Agente" Then
      Set aRng = aTbl.Range
      
    ElseIf aTbl.Cell(1, 1).Range.Text Like "Local*" Then
      bHit = False
      For iRow = 2 To aTbl.Rows.Count
        Set aRow = aTbl.Rows(iRow)
        If Not InStr(aRow.Cells(2).Range.Text, sText) > 0 Then
          aRow.Range.Font.Hidden = True
        Else
          bHit = True
          Set aCell = aRow.Cells(aRow.Cells.Count)
          sRefs = sRefs & "|" & Split(aCell.Range.Text, vbCr)(0)   'builds a list of all the wanted refs
        End If
      Next iRow
      If Not bHit Then
        aRng.End = aTbl.Range.End
        aRng.Font.Hidden = True
      End If
      Set aRng = Nothing
    End If
  Next aTbl
  
  If Len(sRefs) > 0 Then
    With ActiveDocument.Tables(ActiveDocument.Tables.Count)
      Debug.Print sRefs
      .Range.Font.Hidden = False
      For iRow = 2 To .Rows.Count
        sTag = Split(.Rows(iRow).Cells(1).Range.Text, vbCr)(0)
        .Rows(iRow).Range.Font.Hidden = Not InStr(sRefs, sTag) > 0
      Next iRow
    End With
    
    With ActiveWindow.View
      .ShowAll = False
      .ShowHiddenText = False
    End With
  Else
    MsgBox "There were no table rows with " & sText & " in Column 2", vbInformation + vbOKOnly, "Not found"
    ActiveDocument.Range.Font.Hidden = False    'show everything
  End If
End Sub