Keeping just the rows with specific word (BUT KEEP THE TITLE)

Guessed · #1 05-28-2017, 05:59 PM

I've made lots of assumptions based on the content you provided in your sample document. If any of those assumptions are incorrect in your other docs then those need to be resolved. For instance, I assume that the last table in the document is where the references are sitting.

In my testing, the last table would have been ignored in the table loop (since it didn't trigger any of the If tests) and then the following code should address it directly

Code:

  With ActiveDocument.Tables(ActiveDocument.Tables.Count)
    Debug.Print sRefs
    For Each aRow In .Rows
      sTag = Split(aRow.Cells(1).Range.Text, vbCr)(0)
      'Debug.Print sTag
      aRow.Range.Font.Hidden = Not InStr(sRefs, sTag) > 0
    Next aRow
  End With

Try stepping through this section of the code to see if you can work out why it isn't working in your document. Maybe add a couple of lines of code to reveal the entire table before looping through the rows eg.

Code:

  With ActiveDocument.Tables(ActiveDocument.Tables.Count)
    Debug.Print sRefs
    .Range.Font.Hidden = False
    .Select
    For Each aRow In .Rows
      sTag = Split(aRow.Cells(1).Range.Text, vbCr)(0)
      'Debug.Print sTag
      aRow.Range.Font.Hidden = Not InStr(sRefs, sTag) > 0
    Next aRow
  End With

Note: your code solution of adding ActiveDocument.Range.Font.Hidden = False will reveal the entire document, not just the last table

Kopko · #2 05-29-2017, 04:55 AM

Hey Buddy,

I made some changes to keep the first row of the table data (and also of the last one). ("If Not (InStr(aRow.Range.Text, sText) > 0 Or InStr(aRow.Range.Text, "Local - Equipamento") > 0) Then").
These first rows are the description from what comes above. I tested in several samples and I think it is running perfectly. You said before that when we have the final code maybe ou can change some things to make it faster (or lighter, because it seems to slow the computer when the code run)

So here is the final version that I'm using and it's working fine:

Code:

Sub HideUnwantedRows3()
  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
  
  ActiveDocument.Range.Font.Hidden = False
  sText = InputBox("What text are you searching for?")
  
  For Each aTbl In ActiveDocument.Tables
    If aTbl.Range.Paragraphs(1).Style = "Agente" Then
      Set aRng = aTbl.Range
    ElseIf InStr(aTbl.Range.Text, sText) > 0 Then 'if there is at least one row
      For Each aRow In aTbl.Rows
        If Not (InStr(aRow.Range.Text, sText) > 0 Or InStr(aRow.Range.Text, "Local - Equipamento") > 0) Then
          aRow.Range.Font.Hidden = True
        Else
          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 aRow
      Set aRng = Nothing
    Else
      If Not aRng Is Nothing Then 'hide both tables
        aRng.End = aTbl.Range.End
        aRng.Font.Hidden = True
        Set aRng = Nothing
      End If
    End If
  Next aTbl
  With ActiveDocument.Tables(ActiveDocument.Tables.Count)
    Debug.Print sRefs
    .Range.Font.Hidden = False
    .Select
    For Each aRow In .Rows
      sTag = Split(aRow.Cells(1).Range.Text, vbCr)(0)
      'Debug.Print sTag
      aRow.Range.Font.Hidden = Not (InStr(sRefs, sTag) > 0 or InStr(aRow.Range.Text, "Serviço / Recomendação") > 0)
    Next aRow
  End With
  
  With ActiveWindow.View
    .ShowAll = False
    .ShowHiddenText = False
  End With
End Sub

Again. I want to thank you for your help. It was an awesome experience! I already learned a lot.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Open file which contains specific words in title	Nick70	PowerPoint	2	06-08-2016 06:55 AM
Formatting all tables in doc with specific word in title	jeffreybrown	Word VBA	2	05-01-2016 06:05 PM
Copying specific columns of a table to WORD and deleting rows	ffinley	Word VBA	5	12-07-2015 04:01 PM
Export calendar events from multiple calendars with specific title	rasmus	Outlook	0	02-06-2015 01:58 AM
Extracting specific rows	sbdk82	Excel	4	09-07-2014 10:24 PM