![]() |
#14
|
||||
|
||||
![]()
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Open file which contains specific words in title | Nick70 | PowerPoint | 2 | 06-08-2016 06:55 AM |
![]() |
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 |