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

Guessed · 05-31-2017, 04:01 PM

Try this version. I've added a way of tracking whether the found string was in column 2. There is a new assumption that ":2" is never used in a reference.

Code:

Sub PDIc()
  Dim sText As String, aTbl As Table, aHL As Hyperlink, aCell As Cell
  Dim iRow As Integer, aRng As Range, iPos As Integer, aRow As Row
  Dim sRefs As String, aRowRng As Range, sTag As String, bHit As Boolean

  With ActiveDocument.Range.Font
    .Hidden = False
    .ColorIndex = wdBlack
  End With
  sText = InputBox("Digite a data a ser mantida")
  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 Or InStr(aRow.Cells(3).Range.Text, sText) > 0) Then
          aRow.Range.Font.Hidden = True
        Else
          bHit = True
          Set aCell = aRow.Cells(aRow.Cells.Count)
          If (InStr(aRow.Cells(2).Range.Text, sText) > 0) Then
            aRow.Range.Font.ColorIndex = wdRed
            sRefs = sRefs & "|" & Split(aCell.Range.Text, vbCr)(0) & ":2"
          Else
            sRefs = sRefs & "|" & Split(aCell.Range.Text, vbCr)(0)
          End If
        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)
        iPos = InStr(sRefs, sTag)
        If iPos > 0 Then
          'Debug.Print Mid(sRefs, iPos + Len(sTag), 2)
          If Mid(sRefs, iPos + Len(sTag), 2) = ":2" Then .Rows(iRow).Range.Font.ColorIndex = wdRed
        Else
          .Rows(iRow).Range.Font.Hidden = True
        End If
      Next iRow
    End With

    With ActiveWindow.View
      .ShowAll = False
      .ShowHiddenText = False
    End With
  Else
    MsgBox "A data " & sText & " não possui início previsto em nenhum dos Agentes", vbInformation + vbOKOnly, "Não encontrado"
    ActiveDocument.Range.Font.Hidden = False    'show everything
  End If
End Sub

The code is getting more and more confusing because you have tacked on additional requirements each time a working solution was provided. If all the requirements were provided up front it would probably have resulted in a more efficient solution. A dictionary object would be a better method for keeping track of where the hits occurred but would require too much recoding to bother at this stage.