#16
|
||||
|
||||
Changing the font colour is not a problem but you are going to get confusing results if there is already red text in the document before you run the code. Your sample doc has a bunch of red text in the last table. So you probably need to add code up the top that sets everything to black before you begin (like the code that unhides everything at the start).
The extra condition of highlighting rows when the text appears in the second column is unclear. Are you trying to highlight the row in the last table or in the feeder tables or both? Do you want the red if the sText appears in the second column but not if it appears in the third column? If so then you need a way of storing that extra piece of info as you build the list of hits. You might write to two separate strings for each column if you didn't want to change the code dramatically. Or you might add a substring with each ref and then do a split on a split. You might use a Dictionary object to store the hits and locations so you can apply the formatting in a single pass. A Dictionary would be the preferred option now you've added these extra conditions but the coding changes would be more extensive and might be superceded yet again as you ask for more things.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#17
|
|||
|
|||
Quote:
The red if the sText appers just in the second column (and not in the third) it's done. The code below is doing that and it's working great! Code:
Sub PDIc() 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("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) sRefs = sRefs & "|" & Split(aCell.Range.Text, vbCr)(0) 'builds a list of all the wanted refs If (InStr(aRow.Cells(2).Range.Text, sText) > 0) Then aRow.Range.Font.ColorIndex = wdRed 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) .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 "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 But I don't know how to change the color of the last table as well. Dictionary object is a viable solution? I will search about that. One solution that I thought is to paint the remaining tables (after hiding) in red and then paint back to black the rows where columns matchs with sText. The sample is always in black (everything). The first sample that I added here was already painted manually. Thank you again sir! |
#18
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#19
|
|||
|
|||
Thanks again buddy,
this version is working perfectly.! Two questions 1) is it possible to format the tables to clear the gaps after hiding? For example, when a table is half in one page and half in another. Is there any function that I could explore to fix that? 2) instead of typing a word, I want to type a date like 08/05/2017 and if the person type another word instead of a date, it get a message of an error like "Please type a valid date" I tried to substitute "sText as String" to "sText as Date" and it seems to work. I just need to get the error message working. I'm searching about the MsgBox now. |
#20
|
||||
|
||||
To keep tables together, use styles which include the paragraph formatting "Keep with Next" turned on.
To force a date in the InputBox, do a google search "inputbox date validation" to view code samples like... https://www.mrexcel.com/forum/excel-...alidation.html https://social.msdn.microsoft.com/Fo...orum=vbgeneral
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#21
|
|||
|
|||
Thank you buddy. I got it both running. The code is really awesome now.
I will keep ask you some questions, you can be free to ignore me whenever you want. I followed your advice about the formatting and did this: Code:
With Selection.ParagraphFormat .KeepWithNext = True End With What I thought to do is to merge the Table Agente with the data table below. I know this will require to change the structure of the code and I also don't know how hard can this change affect the whole code. Could you give me a light again please? Thanks! |
Thread Tools | |
Display Modes | |
|
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 |