|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Find a text that's equal to "HELLO" in a table cell and copy the left side content.
Dears,
I have a Word Document with approximately 1000 tables. Each table may have 1, 2, 3, 4, 5, or even six columns. I want to create a VBA code that goes through all my Word tables, checking on every cell if there is a specific text ("HELLO") in this sample. So, on the last page of my Word Document, the macro should create a new table with 4 columns and insert the following information: Column 1: The Check explained below (1) Column 2: The entire text of the left side cell. Column 3: The page header where the text "HELLO" was found Column 4: The page number where the text "HELLO" was found (1) The check: Whenever the text "HELLO" is found, the macro should check the content of the left side cell. If the left side cell's text contains the word "APPLE" the code should populate column 1 with the text "I LIKE APPLES". If the left side cell's text contains the word "BANANA", then the code should populate column 1 with the text "I DON'T LIKE BANANA" End, if possible, the text on the Column 2 must be a hyperlink that, if clicked, directs the user to the page where this text came from. Please, find a sample file attached here! How can I do that? Any help is very welcome! Thanks a lot |
#2
|
||||
|
||||
The following will produce the expected table from your sample document (without its expected table)
Code:
Sub Macro1() Dim oTable As Table Dim oCell As Cell Dim oRng As Range, oHeader As Range Dim oColl As Collection Dim i As Long Set oColl = New Collection For Each oTable In ActiveDocument.Tables For Each oCell In oTable.Range.Cells If InStr(1, oCell.Range.Text, "HELLO") > 0 Then Set oRng = oCell.Range oRng.End = oRng.End - 1 Set oHeader = oCell.Range.Sections(1).Headers(wdHeaderFooterPrimary).Range oHeader.End = oHeader.End - 1 Select Case True Case InStr(1, oRng.Text, "APPLE") > 0 oColl.Add "I LIKE APPLES|" _ & oRng.Text & "|" _ & oHeader.Text & "|" _ & oRng.Information(wdActiveEndPageNumber) Case InStr(1, oRng.Text, "BANANA") > 0 oColl.Add "I DON'T LIKE BANANA|" _ & oRng.Text & "|" _ & oHeader.Text & "|" & _ oRng.Information(wdActiveEndPageNumber) End Select End If Next oCell Next oTable Set oRng = ActiveDocument.Range oRng.Collapse 0 oRng.InsertParagraphBefore Set oTable = ActiveDocument.Tables.Add(oRng, oColl.Count, 4) oTable.Columns(1).Width = CentimetersToPoints(4) oTable.Columns(2).Width = CentimetersToPoints(5) oTable.Columns(3).Width = CentimetersToPoints(4.5) oTable.Columns(4).Width = CentimetersToPoints(1.5) For i = 1 To oColl.Count oTable.Rows(i).Cells(1).Range.Text = Split(oColl(i), "|")(0) oTable.Rows(i).Cells(2).Range.Text = Split(oColl(i), "|")(1) oTable.Rows(i).Cells(3).Range.Text = Split(oColl(i), "|")(2) oTable.Rows(i).Cells(4).Range.Text = Split(oColl(i), "|")(3) Next i lbl_Exit: Set oTable = Nothing Set oCell = Nothing Set oRng = Nothing Set oHeader = Nothing Set oColl = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Thanks for your kindly response.
Your code is perfectly working with my sample, but it's not working on the real document. I strongly believe that it's associate with the select case statement. If I change the text from "HELLO 1 - BANANA" to something like "CAR RESALES" and change the code at the select case statement from "APPLE" to "CAR", the system is not finding anything. The fact is that I'll never have the word "HELLO" in the third column as I wrongly provided to you in my sample document. Please, check the following picutres for a better understanding. Would you mind helping me again? Thanks |
#4
|
||||
|
||||
You make it very difficult to assist if your examples are unrelated to reality. However
the following may work for you. If not post a real example. Code:
Sub Macro1() Dim oTable As Table Dim oCell As Cell Dim oRng As Range, oHeader As Range Dim oColl As Collection Dim i As Long Set oColl = New Collection For Each oTable In ActiveDocument.Tables For Each oCell In oTable.Range.Cells If InStr(1, oCell.Range.Text, "HELLO") > 0 Then If oCell.Range.Font.ColorIndex = wdBlue Then Set oRng = oCell.Previous.Range oRng.End = oRng.End - 1 Set oHeader = oCell.Range.Sections(1).Headers(wdHeaderFooterPrimary).Range oHeader.End = oHeader.End - 1 Select Case True Case InStr(1, oRng.Text, "APPLE") > 0 oColl.Add "I LIKE APPLES|" _ & oRng.Text & "|" _ & oHeader.Text & "|" _ & oRng.Information(wdActiveEndPageNumber) Case InStr(1, oRng.Text, "CAR RESALES") > 0 oColl.Add "I DON'T LIKE BANANA|" _ & oRng.Text & "|" _ & oHeader.Text & "|" & _ oRng.Information(wdActiveEndPageNumber) End Select End If End If Next oCell Next oTable Set oRng = ActiveDocument.Range oRng.Collapse 0 oRng.InsertParagraphBefore Set oTable = ActiveDocument.Tables.Add(oRng, oColl.Count, 4) oTable.Columns(1).Width = CentimetersToPoints(4) oTable.Columns(2).Width = CentimetersToPoints(5) oTable.Columns(3).Width = CentimetersToPoints(4.5) oTable.Columns(4).Width = CentimetersToPoints(1.5) For i = 1 To oColl.Count oTable.Rows(i).Cells(1).Range.Text = Split(oColl(i), "|")(0) oTable.Rows(i).Cells(2).Range.Text = Split(oColl(i), "|")(1) oTable.Rows(i).Cells(3).Range.Text = Split(oColl(i), "|")(2) oTable.Rows(i).Cells(4).Range.Text = Split(oColl(i), "|")(3) Next i lbl_Exit: Set oTable = Nothing Set oCell = Nothing Set oRng = Nothing Set oHeader = Nothing Set oColl = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
It's now working perfectly. Thank you!
Btw, how can I create a first line with columns header for each of the four columns that your code created? Column 1: "Certification" Column 2: "Title" Column 3: "Section" Column 4: "Page" Once the output table have more than 10 pages, it's important to keep this columns header on every new page. And, is it possible to create a hyperlink on every new line of the table that you code created directing to the appropriate page? How can I do that? Thanks |
#6
|
||||
|
||||
To add the hyperlinks you would need something to link to. The following bookmarks the found items and links to those.
Code:
Sub Macro1() Dim oTable As Table Dim oCell As Cell Dim oRng As Range, oHeader As Range Dim oColl As Collection Dim i As Long, j As Long j = 0 Set oColl = New Collection For Each oTable In ActiveDocument.Tables For Each oCell In oTable.Range.Cells If InStr(1, oCell.Range.Text, "HELLO") > 0 Then If oCell.Range.Font.ColorIndex = wdBlue Then j = j + 1 Set oRng = oCell.Previous.Range oRng.End = oRng.End - 1 oRng.Bookmarks.Add "BM" & j Set oHeader = oCell.Range.Sections(1).Headers(wdHeaderFooterPrimary).Range oHeader.End = oHeader.End - 1 Select Case True Case InStr(1, oRng.Text, "APPLE") > 0 oColl.Add "I LIKE APPLES|" _ & oRng.Text & "|" _ & oHeader.Text & "|" _ & oRng.Information(wdActiveEndPageNumber) Case InStr(1, oRng.Text, "CAR RESALES") > 0 oColl.Add "I DON'T LIKE BANANA|" _ & oRng.Text & "|" _ & oHeader.Text & "|" & _ oRng.Information(wdActiveEndPageNumber) End Select End If End If Next oCell Next oTable Set oRng = ActiveDocument.Range oRng.Collapse 0 oRng.InsertParagraphBefore Set oTable = ActiveDocument.Tables.Add(oRng, oColl.Count + 1, 4) With oTable .Columns(1).Width = CentimetersToPoints(4) .Columns(2).Width = CentimetersToPoints(5) .Columns(3).Width = CentimetersToPoints(4.5) .Columns(4).Width = CentimetersToPoints(1.5) .Rows(1).Range.Font.Bold = True .Cell(1, 1).Range.Text = "Certification" .Cell(1, 2).Range.Text = "Title" .Cell(1, 3).Range.Text = "Section" .Cell(1, 4).Range.Text = "Page" .Rows(1).HeadingFormat = True For i = 1 To oColl.Count .Rows(i + 1).Cells(1).Range.Text = Split(oColl(i), "|")(0) .Rows(i + 1).Cells(2).Range.Text = Split(oColl(i), "|")(1) .Rows(i + 1).Cells(3).Range.Text = Split(oColl(i), "|")(2) .Rows(i + 1).Cells(4).Range.Text = Split(oColl(i), "|")(3) ActiveDocument.Hyperlinks.Add _ Anchor:=.Rows(i + 1).Cells(4).Range, _ Address:="", _ SubAddress:="BM" & Split(oColl(i), "|")(3), _ ScreenTip:="", _ TextToDisplay:=Split(oColl(i), "|")(3) Next i End With lbl_Exit: Set oTable = Nothing Set oCell = Nothing Set oRng = Nothing Set oHeader = Nothing Set oColl = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#7
|
|||
|
|||
Hello,
Thanks for your kindly support, but It's not working perfectly. Your new code is creating the bookmarks and the links at the last column (page number). But the problem is that when I click on the link, it's not directing to the appropriate page. It's directing to a wrong page. How can I solve it? |
Tags |
cells, copy, table |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Underlined Purple Text and "formatted" boxes at side of document | SeanCGR | Word | 1 | 06-20-2014 06:49 AM |
How to edit the "Format" and the "show level" of an EXISTING table of content? | Jamal NUMAN | Word | 2 | 08-14-2011 10:46 AM |
"Table of content" based on "Normal Style" behavior!!!! | Jamal NUMAN | Word | 4 | 07-08-2011 04:12 AM |
Why the left edge of an inserted table is out "text boundary" by default? | Jamal NUMAN | Word Tables | 2 | 06-30-2011 04:47 PM |
How to have colons (:) in the "Table of content" but to be hidden in the "Heading"? | Jamal NUMAN | Word | 0 | 06-26-2011 04:53 PM |