Macro to Count Rows in One Table and Add that # Rows in Second Table - vba

I have a word document with a number of tables.
I'm trying to build a Macro to count the number of rows in Table1, store that number as Variable: [n_rows], then insert [n_rows] into Table7.
I'm working with bookmarks in case users add new tables, but I'm open to the idea of just using ActiveDocument Tables or whatever.
I'm getting "invalid or unqualified reference" on my .Variables line of my code (see below).
Help!
Sub CountRows()
'
' CountRows
'
'
If ActiveDocument.Bookmarks.Exists("Objectives") = True Then
ActiveDocument.Bookmarks.Item("Objectives").Select
.Variables("numrows").Value = Selection.Tables(1).Rows.Count
End If
Selection.GoTo What:=wdGoToBookmark, Name:="LogFrameSO"
Selection.InsertRowsBelow [NumRows]
End Sub

If you were to be using code like:
.Variables("numrows").Value
a Document variable named 'numrows' would have to exist; and
with your existing code, you would need to reference it as ActiveDocument.Variables("numrows").Value in both instances.
Try:
Sub AddRows()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument
If .Bookmarks.Exists("Objectives") Then
r = .Bookmarks("Objectives").Range.Tables(1).Rows.Count
End If
If .Bookmarks.Exists("LogFrameSO") Then
With .Bookmarks("LogFrameSO").Range.Tables(1).Rows
For i = 1 To r
.Add
Next
End With
End If
End With
Application.ScreenUpdating = True
End Sub

Related

Merge cells of tables in the header in Word VBA

I would like to merge two cells of the second table in the header of my Word document. I created the script below but it has a run-time error: '5491'.The requested member of the collection does not exist.
The error occured on this line" With xTable(2)"
Sub mergercells()
Set xTable = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables
With xTable(2)
.Cell(Row:=3, Column:=2).Merge _
MergeTo:=.Cell(Row:=3, Column:=1)
.Borders.Enable = False
End With
End Sub
Thanks,
All you need is:
Sub MergeCells()
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(2)
.Cell(Row:=3, Column:=2).Merge MergeTo:=.Cell(Row:=3, Column:=1)
.Borders.Enable = False
End With
End Sub

Sub to find text in a Word document by specified font and font size

Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub

How do I get the name of a table from a range variable?

I dimmed the variable:
Dim mainTableRange As Range
Then gave it a value:
Set mainTableRange = Range("tLedgerData") ' tLedgerData is an Excel table.
Now I'm trying to get the name of the table (which is "tLedgerData") from the variable to reference columns in that table even if the table name changes.
I tried
mainTableRange.Name
and
mainTableRange.Name.Name
(See how do you get a range to return its name.) Both threw run-time error '1004': Application defined or object-defined error.
mainTableRange.Select selected all table data excluding the header and total rows.
I think you're having an X-Y problem here: solving problem X when the solution is for problem Y.
[...] to reference columns in that table even if the table name changes
Have the table / ListObject alone on its own dedicated worksheet, and give the sheet a CodeName. That way you can do this:
Dim tbl As ListObject
Set tbl = LedgerDataSheet.ListObjects(1)
And now you have the almighty power of the ListObject API to do whatever it is that you want to do. For example, retrieve the column names:
Dim i As Long
For i = 1 To tbl.ListColumns.Count
Debug.Print tbl.ListColumns(i).Name
Next
In other words, you don't need to care for the name of the table. What you want is to work with its ListObject. And since you never need to refer to it by name, the table's name is utterly irrelevant and the user can change it on a whim, your code won't even notice.
I believe an Excel table and named-range are two different things which is why the .name.name doesn't work. A table is a ListObject and once you set a range equal to a table you should be able to continue to call that range without an error.
Curious, what is the reason why your table might change unexpectedly?
I wrote out some lines of code to show a couple things. You can create tables and reuse the range variables after the table name changes. You can also set AlternativeText for the table with some identifying string and use that to locate a particular table if you suspect the table name may change.
Option Explicit
Public TestTable As Range
Sub CreateTable()
ActiveSheet.ListObjects.Add(xlSrcRange, [$A$1:$C$4], , xlYes).name = "Table1"
ActiveSheet.ListObjects("Table1").AlternativeText = "Table1"
End Sub
Sub SetTableRange()
Set TestTable = Range("Table1")
End Sub
Sub SelectTable()
TestTable.Select
End Sub
Sub RenameTable()
ActiveSheet.ListObjects("Table1").name = "Table2"
[A1].Select
End Sub
Sub SelectRenamedTable()
TestTable.Select
End Sub
Sub ClearSelection()
[A1].Select
End Sub
Sub FindTable1()
Dim obje As ListObject
For Each obje In ActiveSheet.ListObjects
If obje.AlternativeText = "Table1" Then
MsgBox "Found " & obje.AlternativeText & ". Its current name is: " & obje.name
End If
Next obje
End Sub
Sub ConvertTablesToRanges()
' I found this snippet in a forum post on mrexcel.com by pgc01 and modified
Dim rList As Range
On Error Resume Next
With ActiveSheet.ListObjects("Table1")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
With ActiveSheet.ListObjects("Table2")
Set rList = .Range
.Unlist ' convert the table back to a range
End With
On Error GoTo 0
With rList
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = xlColorIndexAutomatic
.Borders.LineStyle = xlLineStyleNone
End With
End Sub

How to mark and recognize back a table via bookmarks

I am trying to insert tables marked with a Name via a bookmark so I can later recognize them again.
Below I have added my source code in question. At pos3 I created a table with 2 rows and add a bookmark for its range. But when repeating the Sub I always end up in the case of pos1 .. my bookmark is not found in the table selection. (trying to reach pos2)
The bookmark itself is added, but maybe not to the table. I suspect the error to be there.
I can see the bookmark in the bookmark-list of Word. But if I do a manual "go to" the cursor seems to end up off screen somewhere, so I suspect its not added correctly to the table range.
Private Sub PrepareFooter()
Dim oSection As Section
Dim oFooter As HeaderFooter
Dim oRng As Range
Dim tbl As Table
Dim cell As cell
Dim foundFooterTable As Boolean
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
With oFooter.Range
For Each tbl In .Tables
tbl.Select
If Selection.Bookmarks.Count <> 1 Then
tbl.Delete ' <-- pos1
ElseIf Selection.Bookmarks(1).Name <> "FooterTable" Then
tbl.Delete
Else
foundFooterTable = True ' <-- pos2
FormatFooterTable tbl
End If
Next
End With
oFooter.Range.Select
Selection.Collapse wdCollapseStart
If Not foundFooterTable Then
Set tbl = ActiveDocument.Tables.Add(Selection.Range, 2, 1)
tbl.Select
ActiveDocument.Bookmarks.Add Range:=Selection.Range
, Name:="FooterTable" ' <- pos3
FormatFooterTable tbl
End If
Next oFooter
Next oSection
End Sub
thanks for any ideas about what I might do wrong!
Try to work without Selection as much as you can. Whenever possible, use a Range object. That will make your code clearer and more reliable.
In order to put a bookmark "around" a table (pos 3):
ActiveDocument.Bookmarks.Add Range:=tbl.Range, Name:="FooterTable"
When this works, you should be able to get the table using:
Dim sFooterTable as String
sFooterTable = "FooterTable"
If ActiveDocument.Bookmarks.Exists(sFooterTable) Then
Set tbl = ActiveDocument.Bookmarks(sFooterTable).Range.Tables(1)
found my mistake:
I was applying the same bookmark name on all tables that were found .. this way deleting the previous bookmarks as they need a unique name.
adding a unique identifier in the end (I used an integer now) made the code work.

VBA Word: How can I find in which table something (i.e. selection) is?

I have in my word document many tables, each is linked to bookmark.
Then I have function which scan document for each tracked change (revisions).
How can I find out where my tracked change is? in which table?
Here is some of my code:
Dim ThisWord As Document, TabHead As Table
Set ThisWord = ActiveDocument
Set TabHead = ThisWord.Bookmarks("Head").Range.Tables(1) '"Head" is bookmark for my first table
For Each oRevision In ThisWord.Revisions 'Run through each revision - tracked change
Select Case oRevision.Type
Case wdRevisionInsert
strText = oRevision.Range.Text
If oRevision.Range.Information(wdWithInTable) = True Then 'Check if tracked change is within table
Select Case oRevision.Range.Table ' <-- How can I change this part???
Case TabHead
'do some stuff with strText
'Case AnotherTable1
'Case AnotherTable2
'...
end select
end if
end select
next oRevision
My main goal is to track down all changes in word document, get date and time and user of that change. By I need to know where that change was made. Tracked change function can give me all that detail, but how to determine where that change was made?
Through the Range object, you have acces to all the different objects in the revision. If you want to reference the first Table object then use:
oRevision.Range.Tables(1)
You obviously need to check to see that there are tables before using the reference (e.g If oRevision.Range.Tables.Count > 0 Then ...).
You could also access the bookmarks collection in the same way:
If oRevision.Range.Bookmarks.Count > 0 Then
Debug.Print oRevision.Range.Bookmarks(1).Name
End If
This gives you the table number of Selection.
Sub Demo()
Dim iTable&
With Selection
If Not .Information(wdWithInTable) Then
MsgBox "The selection is not in a table!"
Exit Sub
End If
For iTable = 1 To ActiveDocument.Tables.Count
If (.Range.Start >= ActiveDocument.Tables(iTable).Range.Start) And _
(.Range.End <= ActiveDocument.Tables(iTable).Range.End) Then
Exit For
End If
Next iTable
End With
MsgBox "It's in table # " & iTable
End Sub
From macropod https://groups.google.com/forum/#!searchin/microsoft.public.word.programming/%22table%22$20which/microsoft.public.word.programming/Gid7abgeAek/c5rUWhFmWwgJ