Solved: Insert Text below a table

[fredlo2010]

Hello guys,

I have this document that contains a series of tables. The tables are basically divided in two groups:
1. Header tables
2. Body tables

I would like to do the following. take a value from table 1 and round it to two decimal places.
Then insert a paragraph between Header-tables and Body-tables with the following " Amount" and then the value that was rounded from above times 28.

I have attached a sample of my document with before and after.

Thanks a lot for your help.

Original
https://dl.dropbox.com/u/30987064/New%20Folder/Original.docx

Output
https://dl.dropbox.com/u/30987064/New%20Folder/Desired%20Output.docx

PS: Is it me or Word VBA is harder than Excel VBA?

[fumei]

PS: Is it me or Word VBA is harder than Excel VBA?

It is just you. Just kidding. They ARE different for sure. With the Selection (cursor) in the table with the original number ($ 68.4611), try:

Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim CellContent As String
Dim r As Range

Set r = Selection.Tables(1).Range
CellContent = Format(CellText(Selection.Tables(1).Cell(2, 3)), "#.00")
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
End With
End Sub
To explain, the function returns the cell text, stripping off the end-of-cell marker (very important). The Format function makes it two decimal places. That string is added with "Amount: " to the paragraph after the table.

As you do not specify which table the code above starts with the Selection IN the table you want.

[fumei]

Oh and the cell to grab the number from is hard-coded - Cell(2,3). This could be adjusted if need be.

I also used having the Selection IN the table because:

"I would like to do the following. take a value from table 1 and round it to two decimal places. "

Except the value is NOT in table 1 in your example, it is in table 2. So, to be sure i stipulated the Selection in the table you want.

Oh, and there really should be error checking to make sure the selection actually is in a table.
Sub Yadda()
Dim CellContent As String
Dim r As Range
If Selection.Information(wdWithInTable) Then
Set r = Selection.Tables(1).Range
CellContent = Format(CellText(Selection.Tables(1).Cell(2, 3)), "#.00")
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
End With
Else
MsgBox "Selection is not in a table."
End If
End Sub

[fumei]

And finally...

IF the source table is the same (2 rows) for all the ones you want to action, AND those are all different from the other tables (NOT 2 rows), then it would be very easy to run through all such tables in your document.

[fredlo2010]

Thanks a lot fumei this has been of great help. But i am still struggling. ( I am not VBA Expert or anything)

I Am having issues with the loop part of the code. I need to go through all the tables that meet these two conditions:

1. It has two rows
2. Cell(1,1) is empty

If the above is met then perform the action.

This code will run right after another so I need to automatically place the selection in the table so i don't get the " Selection is not within a table"

Is it possible to modify the value of the cell? I want to round the value that's in the cell in the table as well. But I don't know how to get it. I tried Cell().value and Cell().text but its not doing anything.

So here is the code I have now. I modified yours a little so I would get some formatting in my text placed below the table. But I bet it can be improved and shorten it. lol

Once again thanks a lot

Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim CellContent As String
Dim r As Range
Dim i As Long
Dim tCount As Long

tCount = ThisDocument.Tables.Count

For i = 1 To tCount

If Tables(i).Cell(1, 1) = vbNullString And Tables(i).Rows.Count = 2 Then

If Selection.Information(wdWithInTable) Then
Set r = Selection.Tables(1).Range
CellContent = Format(CellText(Selection.Tables(i).Cell(2, 3)), "#.00")
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Underline = wdUnderlineSingle
.Font.Size = "12"
.Font.Bold = True
.Select
End With
With Selection
.Collapse Direction:=wdCollapseStart
.MoveRight Unit:=wdCharacter, Count:=8
.TypeText Text:="$"
.TypeText Text:=" "
End With
Else
MsgBox "Selection is not in a table."
End If
End If
Next i
End Sub

[Frosty]

I am of the belief that when you have a set of criteria you are basically using as a filter, it is best to encapsulate that in a separate function. This allows you to change that criteria later without having to read through the entire function.

You're having problems with the loop part of the code because your coding articulation of your desired criteria is bad.

In a word table, the following will never be true (and, in fact, is a type mismatch-- so your code can't even work, unless you've made a typo??)
Tables(i).Cell(1, 1) = vbNullString
But even if you accurately put on a .Range to the end of that
Tables(i).Cell(1,1).Range = vbNullString
It still wouldn't ever be true...

This is because all cells in Word have some bit of text in them. That is the purpose of Fumei's CellText function.

What I would do is create a separate function and use a For Each loop instead. From there, you can probably remove your use of the selection entirely... but since I'm not sure what exactly you're trying to do (you loop through all tables in the document, but then require that the table you're working on be selected previous to the operation of the macro).

So I'm not going to try and clean that code up, because I don't know your before and after... but structurally, this should get you closer...

Function fIsValidTable(oTbl As Table)
'has to have more than one row
If oTbl.Rows.Count = 2 Then
'and an empty first cell
If CellText(oTbl.Cell(1, 1)) = "" Then
fIsValidTable = True
End If
End If
End Function
Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim oTbl As Table

For Each oTbl In ActiveDocument.Tables
If fIsValidTable(oTbl) Then
'do your stuff
End If
Next
End Sub

[Frosty]

Oh, and I would really double-check whether you want to use ThisDocument (which *always* refers to the document or template containing the macro) or ActiveDocument (which is the current document on the screen).

Note: the Selection object *always* refers to the current document on the screen (i.e., the ActiveDocument), but only *sometimes* would refer to the ThisDocument.

If that doesn't make sense-- I would read up on the help file about ActiveDocument and ThisDocument.

[fredlo2010]

Hello guys,

Thanks a lot for the help. The tips are very useful. I think I am trying to apply the little I know of Excel VBA concepts here.

I tried to combine fumei and Frosty's code but It doesnt seem to work.It gives me an error "Method or data member not found"

Here is the code

Function fIsValidTable(oTbl As Table)
'has to have more than one row
If oTbl.Rows.Count = 2 Then
'and an empty first cell
If CellText(oTbl.Cell(1, 1)) = "" Then
fIsValidTable = True
End If
End If
End Function
Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim oTbl As Table
Dim CellContent As String
Dim r As Range
Dim i As Long
Dim tCount As Long

For Each oTbl In ActiveDocument.Tables
If fIsValidTable(oTbl) Then

If Selection.Information(wdWithInTable) Then

Set r = Selection.oTbl.Range ' Error Here
CellContent = Format(CellText(Selection.oTbl.Cell(2, 3)), "#.00")
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Underline = wdUnderlineSingle
.Font.Size = "12"
.Font.Bold = True
.Select
End With
With Selection
.Collapse Direction:=wdCollapseStart
.MoveRight Unit:=wdCharacter, Count:=8
.TypeText Text:="$"
.TypeText Text:=" "
End With
Else
MsgBox "Selection is not in a table."
End If
End If
Next
End Sub



Here are some dropbox links to before and after.

Original
https://dl.dropbox.com/u/30987064/New%20Folder/Original.docx

Output
https://dl.dropbox.com/u/30987064/New%20Folder/Desired%20Output.docx

[fumei]

Well I have to agree with Frosty regarding the validation, but I also asked if the source tables were the ONLY ones with 2 rows. It appears they are, so....
Option Explicit

Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim oTable As Table
Dim CellContent As String
Dim r As Range
For Each oTable In ActiveDocument.Tables
' if the table is 2 rows
If oTable.Rows.Count = 2 Then
Set r = oTable.Range
' get the content of the cell and format it to 2 decimals
CellContent = Format(CellText(oTable.Cell(2, 3)), "#.00")
' REPLACE the content as 2 decimals
oTable.Cell(2, 3).Range.Text = "$ " & CellContent
With r
.Collapse 0
' add the Amount
.Text = "Amount: " & CellContent * 28
' formatted to the Amount style
.Style = "Amount"
End With
Set r = Nothing
End If
Next
End Sub
This avoids using Selection whatsoever - always a good idea, and also avoids the manual formatting for the Amount paragraph. Simply make a Style and apply it. In my test I made it underlined, 12 point, and before/after spacing of 8 pts. But you can do whatever you like. It is a style after all.

[fumei]

Oh and...
For Each oTbl In ActiveDocument.Tables
If fIsValidTable(oTbl) Then
If Selection.Information(wdWithInTable) Then
Set r = Selection.oTbl.Range ' Error Here
Yup it sure will error. There is no way the selection can be in each oTbl.

[fredlo2010]

Thanks a lot guys,

I am so close to achieve what I want. I made some modifications to the code. I added a new check to make sure we are using the right table. The table must have two rows and 5 columns.

Instead of using your suggestion of adding a style and then applying to the new paragraph I decided to keep the hard coding. I am not always going to be the final user of the macro, also I might have to use it in different computers.

There is only one final thing I need to check. Is it possible to round up the value and not just use the decimals after the point. so for example if I have $ 68.4611, then I get $ 68.46; but if i have $ 68.4651 then I should get $ 68.47; the last number is the one I am supposed to multiply by 28.

I found an article online that fixes that issue bu adding 0.0005, but I would like to know if you guys know a better way. I am not certain how reliable this is.

So here is the new updated code

Option Explicit

Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Sub Yadda()
Dim oTable As Table
Dim CellContent As String
Dim r As Range

For Each oTable In ActiveDocument.Tables
' if the table is 2 rows
If oTable.Rows.Count = 2 And oTable.Columns.Count = 5 Then
Set r = oTable.Range
' get the content of the cell and format it to 2 decimals, also add the $ sign
CellContent = Format(CellText(oTable.Cell(2, 3)) + 0.0005, "$ #.00")
' REPLACE the content as 2 decimals
oTable.Cell(2, 3).Range.Text = CellContent
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Underline = wdUnderlineSingle
.Font.Size = "11"
.Font.Bold = True
.Select
End With
With Selection
.Collapse Direction:=wdCollapseStart
.TypeParagraph
.MoveRight Unit:=wdCharacter, Count:=8
.TypeText Text:="$ "
End With
Set r = Nothing
End If
Next
End Sub

[fredlo2010]

All fixed now. I found a fucntion online that uses an excel reference funtion to round the value.

Thanks to all of you for the help. Fumei, Frosty you guys rock.

Here is the final code:

Option Explicit

Function CellText(aCell As Cell) As String
Dim r As Range
Set r = aCell.Range
CellText = Left(r.Text, Len(r.Text) - 2)
End Function
Function ExcelRound(dValue As Double, dDec As Double) As Double
Dim oExcel As Object
Set oExcel = CreateObject("Excel.Application")
With oExcel.WorksheetFunction
ExcelRound = .Round(dValue, dDec)
End With
Set oExcel = Nothing
End Function
Sub Yadda()
Dim oTable As Table
Dim CellContent As String
Dim r As Range
For Each oTable In ActiveDocument.Tables
' if the table is 2 rows
If oTable.Rows.Count = 2 And oTable.Columns.Count = 5 Then
Set r = oTable.Range
' get the content of the cell and format it to 2 decimals, also add the $ sign
CellContent = Format(ExcelRound(CellText(oTable.Cell(2, 3)), 2), "$ #.00")
' REPLACE the content as 2 decimals
oTable.Cell(2, 3).Range.Text = CellContent
With r
.Collapse 0
.Text = "Amount: " & CellContent * 28
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Underline = wdUnderlineSingle
.Font.Size = "11"
.Font.Bold = True
.Select
End With
With Selection
.Collapse Direction:=wdCollapseStart
.TypeParagraph
.MoveRight Unit:=wdCharacter, Count:=8
.TypeText Text:="$ "
End With
Set r = Nothing
End If
Next
End Sub


This is the website I got the Excel function from http://www.vbaexpress.com/forum/archive/index.php/t-2766.html

[fumei]

Good heavens! Are you serious???? You are going to make a new instance of Excel just to use one function briefly? Not only that, but if you have five tables you are creating Excel FIVE separate times!

Yikes.

There is only one final thing I need to check. Is it possible to round up the value and not just use the decimals after the point. so for example if I have $ 68.4611, then I get $ 68.46; but if i have $ 68.4651 then I should get $ 68.47; the last number is the one I am supposed to multiply by 28.
But if you DO have 68.4611, it sounds like you still want 68.47.

That makes no sense. Or are you saying that anything > 68.46 (68.4601??) should get rounded up?

[fredlo2010]

hi,

I didn't know how bad this was. No the document will have several tables not only five, it can vary from 1 up to 30 sometimes. is this going to use a lot of memory? will it make Word crash?

The round up thing is a typo, sorry about that; I meant to say Round. The code uses the right function though. The tables are used to calculate monetary amounts, a right rounding must be applied.

Thanks for the help.