VBA Word - Find Specific Table

jc491 · #1 12-01-2015, 12:15 PM

Hi,

all and greetings, I hope everyone is doing great today.

I have come to seek some help from the kind folks here, as usual the most helpful forum bar none!

I have a table problem, that I have been battling with.

I am simply trying to find a table in my documents. The table will have a unique identifier such as - #CPT

Once I have found this table I need to apply some text before and after each cell in the table.

That is insert some placeholders.

Please see the image for an idea of what I am trying to Achieve.

http://tinypic.com/r/2rn76ti/9

Its kind of similar to a macro Paul wrote earlier.

http://www.vbaexpress.com/forum/show...-a-Wd-document

So far I have unsuccessfully tested and grappled with the below, bits worked individually and then I got stuck.

Code:

Dim rng As Range
Dim Tbl As Table
Dim Cel As Cell
Set rng = ActiveDocument.Range

' Find the Table with a Unique identifier
    For Each Tbl In .Tables

     With Tbl.range.find
       Do While .Execute(FindText:="#CPT")
       If rng.Information(wdWithInTable) Then

       ' First insert the placeholders  -  before and after the text in the header cells

         Cell(1, 2).Range.Text  =  Cel.Range.(1.2).Text = Replace(Cel.Range.Text, oCel.Range.Text, _
            "Year" & Left(Cel.Range.Text, Len(Cel.Range.Text) - 2) & "Building")
         Cell(2, 2).Range.Text 

       'Insert placeholders before and after the text in each column
     
          For Each Cel In .Columns(1).Cells
            Cel.Range.Text = Replace(Cel.Range.Text, oCel.Range.Text, _
            "student" & Left(Cel.Range.Text, Len(Cel.Range.Text) - 2) & "course")

        For Each Cel In .Columns(2).Cells
            Cel.Range.Text = Replace(Cel.Range.Text, Cel.Range.Text, _
            "previous" & Left(Cel.Range.Text, Len(Cel.Range.Text) - 2) & "pass")

    '  There may be 3 columns in the future that I will adapt this code to
     For Each Cel In .Columns(3).Cells
            Cel.Range.Text = Replace(Cel.Range.Text, Cel.Range.Text, _
            "placeholder1" & Left(Cel.Range.Text, Len(Cel.Range.Text) - 2) & "placeholder2")

As you can see I have got myself into a pickle. I am missing some if statements, and a lot more.

I tried using a mail merge - that approach is not suitable, hence it has to be hard coded like this - So I can apply it to a number of other documents that have this Unique Table code - it will also allow me to change the placeholders easily - do a search and replace and save time for example if I wanted to change the "Course" to something else.

I can also insert new placeholders when new information becomes available.
So it would be really efficient to insert placeholders rather than adding new columns every time.

To Recap:

1. Find a Specific Table by its Code

2. Insert placeholders before and after the text - in the header Cells

3. Insert placeholders before and after the text in each column Cell

4. If it’s possible I would prefer to avoid adding new columns to the existing table - I tried that and the document becomes bloated with extra columns, which poses a different problem.

Life would be easier if it wasn't in a table - but it has to be in a table format, hence my problem.

I would be really grateful for some expert help.

I often embark on these tasks thinking I have enough knowledge to complete it and then before I know it I'm way too lost and have code blindness.

Thanking you so much for your time -

J

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Word 2013 - linking cell data within a table	jhamblin	Word Tables	1	03-15-2015 01:32 AM
How to append specific *.tif image with another tif file through Word VBA	aarun2	Word VBA	1	04-08-2014 03:20 PM
Append text to a sentence containing specific word	dgp	Word VBA	3	02-28-2014 10:38 PM
Word table - how do I append % symbol to each value in columns 3 & 4 of a table	Dawsie	Word	4	03-06-2013 12:33 AM