How to run code in Each table in the document instead of just the First one?

Snaybot · #1 11-09-2015, 06:54 PM

Code:

Sub Macro7()
'
' GBM2 Macro
'

Dim i As Long, StrTxt As String
' Setting the variable
With ActiveDocument.Tables(1)
' Active Documents in the table
  For i = .Rows.Count To 2 Step -1
' Counts the rows by 1 down
    If .Rows(i - 1).Cells.Count > 1 Then
' Rows will count by one cell
      If InStr(.Cell(i, 2).Range.Text, "Ensure S") = 1 Then
' if the second column starts with "Ensure S" you know what I mean the first part of the procedure in the step then
        StrTxt = Split(.Cell(i, 2).Range.Text, " ")(1)
' Until the End or until the space is found after "Ensure S"
        .Rows.Add BeforeRow:=.Rows(i)
' Add an extra row for the Grey Bar
        With .Rows(i)
          .Cells.Merge
          'Merge those Cells!
          .Shading.BackgroundPatternColor = -603930625
          'Grey those cells!
          .Range.Style = wdStyleNormal
          'wdStyleNormal is the normal font template, for me which is Times new roman 12 for others it could be arial or calabri based on the template
          .Range.ParagraphFormat.KeepWithNext = wdToggle
          'Keep with next
          .Range.Text = "Step " & StrTxt
          'add "Step" Text infront of the step number
          .Range.Rows.Height = 18
          'Height is configurable
          .Range.Bold = wdToggle
          'Bold the Grey Bar text
          .Range.Font.Size = 10
          'Now shrink the text
        End With
      End If
    Else
      i = i - 1
      ' Makes the program not crash <- Suprisingly the hardest part lol
    End If
  Next
End With
'
End Sub

I have this Code How do I run it for every table in the Document rather than only the first table?

Cross Posted at:

http://www.mrexcel.com/forum/excel-q...ml#post4337459
http://www.excelforum.com/excel-prog...first-one.html

macropod · #2 11-09-2015, 07:04 PM

Obviously, you'd need to loop through the tables. For example

Code:

Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    'Process the table here
  End With
Next

Snaybot · #3 11-09-2015, 08:35 PM

How would I do that?

Do I just copy and paste my code inside your With statement?

I have tried multiple times. Im pretty novice at this and still learning

I wish there was a select all Tables haha

macropod · #4 11-09-2015, 08:43 PM

You put everything that your code has between 'With ActiveDocument.Tables(1)' and your final 'End With' where the code I posted has:
'Process the table here

PS: Please post Word topics in the appropriate Word forum. Thread moved.

Snaybot · #5 11-09-2015, 08:56 PM

Ahh Im having an error, here.

Run-Time error '5991'

Cannot access individual row in this collection because the table has vertically merged cells

Any way to skip these table

Or start at row 3 on each table?

macropod · #6 11-09-2015, 09:08 PM

You can test the table .Uniform property before processing and either skip the table or process it in a different way if it's false. For example:

Code:

Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    If .Uniform = True Then
      'Process Uniform table here
    Else
      'Process non-Uniform table here (or skip it by leaving out the 'Else' statement)
    End If
  End With
Next

Note: The .Uniform property tests for merged cells - horizontal and vertical - as well as cells of varying widths in a column. It returns False if any of those conditions exists.

Snaybot · #7 11-09-2015, 11:38 PM

Code:

Dim i As Long, StrTxt As String
Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    If .Uniform = True Then
      'Process Uniform table here
      With Tbl
    'Start
    ' Active Documents in the table
  For i = .Rows.Count To 2 Step -1
' Counts the rows by 1 down
    If .Rows(i - 1).Cells.Count > 1 Then
' Rows will count by one cell
      If InStr(.Cell(i, 2).Range.Text, "Ensure S") = 1 Then
' if the second column starts with "Ensure S" you know what I mean the first part of the procedure in the step then
        StrTxt = Split(.Cell(i, 2).Range.Text, " ")(1)
' Until the End or until the space is found after "Ensure S"
        .Rows.Add BeforeRow:=.Rows(i)
' Add an extra row for the Grey Bar
        With .Rows(i)
          .Cells.Merge
          'Merge those Cells!
          .Shading.BackgroundPatternColor = -603930625
          'Grey those cells!
          .Range.Style = wdStyleNormal
          'wdStyleNormal is the normal font template, for me which is Times new roman 12 for others it could be arial or calabri based on the template
          .Range.ParagraphFormat.KeepWithNext = wdToggle
          'Keep with next
          .Range.Text = "Step " & StrTxt
          'add "Step" Text infront of the step number
          .Range.Rows.Height = 18
          'Height is configurable
          .Range.Bold = wdToggle
          'Bold the Grey Bar text
          .Range.Font.Size = 10
          'Now shrink the text
        End With
        End If
    Else
      i = i - 1
      ' Makes the program not crash <- Suprisingly the hardest part lol
    End If
  Next
End If
  End With
Next

End Sub

I still have no luck with this code?

Am I doing it right?
Logically it all makes sense right?

macropod · #8 11-10-2015, 01:39 AM

Do your existing tables have merged cells? If so, the .Uniform test will cause them to be skipped. That's exactly what one would expect from what I said in my previous reply:

Quote:

Note: The .Uniform property tests for merged cells - horizontal and vertical - as well as cells of varying widths in a column. It returns False if any of those conditions exists

Snaybot · #9 11-10-2015, 12:42 PM

Yes I do.

But should that matter?

I use

Code:

With ActiveDocument.Tables(1)

and it works perfectly no matter what is merged in my table

as long as there is a "Ensure S" in the second column

Thanks!

macropod · #10 11-10-2015, 05:13 PM

It matters because your code will then skip over tables with merged cells - that's the whole point of implementing the test that way, as per your request in post #5.

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTxt As String, Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For i = .Range.Cells(.Range.Cells.Count).RowIndex To 2 Step -1
      ' Counts the rows by 1 down
      On Error Resume Next
      If .Rows(i - 1).Cells.Count > 1 Then
        ' Rows will count by one cell
        If InStr(.Cell(i, 2).Range.Text, "Ensure S") = 1 Then
          ' if the second column starts with "Ensure S" you know what I mean the first part of the procedure in the step then
          StrTxt = Split(.Cell(i, 2).Range.Text, " ")(1)
          ' Until the End or until the space is found after "Ensure S"
          .Rows.Add BeforeRow:=.Rows(i)
          ' Add an extra row for the Grey Bar
          With .Rows(i)
            .Cells.Merge
            'Merge those Cells!
            .Shading.BackgroundPatternColor = -603930625
            'Grey those cells!
            .Range.Style = wdStyleNormal
            'wdStyleNormal is the normal font template, for me which is Times new roman 12 for others it could be arial or calabri based on the template
            .Range.ParagraphFormat.KeepWithNext = wdToggle
            'Keep with next
            .Range.Text = "Step " & StrTxt
            'add "Step" Text infront of the step number
            .Range.Rows.Height = 18
            'Height is configurable
            .Range.Bold = wdToggle
            'Bold the Grey Bar text
            .Range.Font.Size = 10
            'Now shrink the text
          End With
        End If
      Else
        i = i - 1
        ' Makes the program not crash <- Suprisingly the hardest part lol
      End If
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub

Snaybot · #11 11-11-2015, 03:12 PM

bingo!

thanks Macropod

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Code to add new row in table	ksigcajun	Word VBA	24	02-16-2023 03:09 PM
VBA Code to take data from a table in word document and place it in a summary table	VBLearner	Word VBA	1	03-09-2014 08:42 PM
VBA sort table code	mikec	Excel Programming	8	10-01-2013 04:37 PM
.OnAction only works in document with the code	donbexcel	Word VBA	1	11-02-2011 05:25 AM
how can I add a peace of code to MS document	amlife	Word VBA	0	03-03-2010 03:35 PM