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

macropod · #2 12-02-2015, 08:22 PM

Try something based on:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim oTbl As Table, i As Long, r As Long, Rng As Range
For Each oTbl In ActiveDocument.Tables
  With oTbl
    If InStr(.Cell(1, 2).Range.Text, "#CPT") > 0 Then
      Set Rng = .Cell(2, 1).Range
      With Rng
        .End = .End - 1
        .InsertBefore "(Year) "
        i = InStr(.Text, " ")
        With .Duplicate
          .End = .Start + i
          .Font.ColorIndex = wdBlue
        End With
        .InsertAfter " (Building)"
        i = InStrRev(.Text, " ")
        With .Duplicate
          .Start = .Start + i
          .Font.ColorIndex = wdBlue
        End With
      End With
      Set Rng = .Cell(2, 2).Range
      With Rng
        .End = .End - 1
        .InsertBefore "(QID) "
        i = InStr(.Text, " ")
        With .Duplicate
          .End = .Start + i
          .Font.ColorIndex = wdBlue
        End With
        .InsertAfter " (Total)"
        i = InStrRev(.Text, " ")
        With .Duplicate
          .Start = .Start + i
          .Font.ColorIndex = wdBlue
        End With
      End With
    For r = 3 To .Rows.Count
      Set Rng = .Cell(r, 1).Range
      With Rng
        .End = .End - 1
        .InsertBefore "(student) "
        i = InStr(.Text, " ")
        With .Duplicate
          .End = .Start + i
          .Font.ColorIndex = wdBlue
        End With
        .InsertAfter " (Course)"
        i = InStrRev(.Text, " ")
        With .Duplicate
          .Start = .Start + i
          .Font.ColorIndex = wdBlue
        End With
      End With
      Set Rng = .Cell(r, 2).Range
      With Rng
        .End = .End - 1
        .InsertBefore "(previous) "
        i = InStr(.Text, " ")
        With .Duplicate
          .End = .Start + i
          .Font.ColorIndex = wdBlue
        End With
        .InsertAfter " (Pass)"
        i = InStrRev(.Text, " ")
        With .Duplicate
          .Start = .Start + i
          .Font.ColorIndex = wdBlue
        End With
      End With
    Next
    End If
  End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

jc491 · #3 12-02-2015, 09:32 PM

Hello Paul,

hope you are great and thank you so much for all the coding help previously as well.

Absolutely smashing - does the job flawlessly.

This VBA code has also eliminated a lot of smaller issues I had regarding a number of tables I am working with. The small details can often make such a big difference, this is one of those things, by eliminating the need for more columns.
Initially I tried a number of other approaches such as adding columns, hiding the data, importing table from another document - yada yada yada - yikes it was enough for me to throw something at the screen.

Columns used in word documents are just not as intuitive as they are in excel and never play nice. With fewer columns, tables are easier to manage as I can simply make the font sizes smaller and then allow them to fill down vertically rather than with extra columns - which run off the page , and make it difficult to read or the the data disapears into oblivion, battling to and fro to get it back on screen.

This is an Awesome VBA Macro - I love it.

Anytime I need to find a table and insert some data I can do it now - knowing that I don't have to copy and paste same table into 10 other documents that needs updating, having to hunt down the table with words search and find, which will find everything you don't need - when you don't need it.

So this has saved me a ton of stress and work - such as having to hunt down tables, its also easier to insert data and placeholders now and leave it be, for looking at later.

Really really grateful for your ineffable generosity and help!

Need I say its really made my week!!

Have a Super Awesome week -

J

PS - I can use this template and adapt it for all sorts of other table magic, I have learned a lot from your coding and adapted macros to make mini me versions

I declare this Solved!

Thank you again!

jc491 · #4 12-02-2015, 09:48 PM

Also,

another reason I am so chuffed, is because of its extensibility I can adapt the code to 20 other different table problems and make a repository of macros, for example such as inserting blocks of text if needed already styled.

So I declare the awesomeness of your macro!

Thank you Again!

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