Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-07-2023, 06:46 PM
bblelli bblelli is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2021
Novice
Find a text that's equal to "HELLO" in a table cell and copy the left side content.
 
Join Date: Feb 2023
Posts: 22
bblelli is on a distinguished road
Angry 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
Attached Files
File Type: docx Sample.docx (27.6 KB, 3 views)
Reply With Quote
  #2  
Old 03-08-2023, 03:02 AM
gmayor's Avatar
gmayor gmayor is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #3  
Old 03-08-2023, 04:17 AM
bblelli bblelli is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2021
Novice
Find a text that's equal to "HELLO" in a table cell and copy the left side content.
 
Join Date: Feb 2023
Posts: 22
bblelli is on a distinguished road
Default

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
Attached Images
File Type: png Not Working (real).PNG (4.8 KB, 9 views)
File Type: png Working (sample).PNG (5.7 KB, 9 views)
Reply With Quote
  #4  
Old 03-08-2023, 08:29 AM
gmayor's Avatar
gmayor gmayor is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #5  
Old 03-08-2023, 07:45 PM
bblelli bblelli is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2021
Novice
Find a text that's equal to "HELLO" in a table cell and copy the left side content.
 
Join Date: Feb 2023
Posts: 22
bblelli is on a distinguished road
Default

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
Reply With Quote
  #6  
Old 03-08-2023, 09:40 PM
gmayor's Avatar
gmayor gmayor is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Reply With Quote
  #7  
Old 03-09-2023, 10:04 PM
bblelli bblelli is offline Find a text that's equal to "HELLO" in a table cell and copy the left side content. Windows 10 Find a text that's equal to "HELLO" in a table cell and copy the left side content. Office 2021
Novice
Find a text that's equal to "HELLO" in a table cell and copy the left side content.
 
Join Date: Feb 2023
Posts: 22
bblelli is on a distinguished road
Default

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?
Reply With Quote
Reply

Tags
cells, copy, table

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find a text that's equal to "HELLO" in a table cell and copy the left side content. 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
Find a text that's equal to "HELLO" in a table cell and copy the left side content. "Table of content" based on "Normal Style" behavior!!!! Jamal NUMAN Word 4 07-08-2011 04:12 AM
Find a text that's equal to "HELLO" in a table cell and copy the left side content. 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

Other Forums: Access Forums

All times are GMT -7. The time now is 02:02 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft