Adding Multiple Rows to a Table in a Word Form

A

AltNrg4U

First off I would like to thank all of the people that post, and all
the people that respond. I have lurked for a long time, dependent on
the Q&A of others.

Today I have spent 12 hours reviewing and steeling snippets from all
over the web. I have my table set up to add a row at the end of my
table on my protected form, and to add a text form field to 5 of the 7
cells, and also add & populate 2 separate dropdown lists. This works
and I could stop here.

That being said, my table can be updated with only several rows or up
to 5 full pages. I would like to tweak my VBA code to request some
sort of input and it would populate that many rows. I am guessing that
the best answer would be to loop my current code the number of times
the user input. If so, I am guessing it should be fairly easy addition
for the loop. Lastly, I am posting because I am sure there are other
people that may / will be looking for a similar solution.
I am enclosing my code below in case this information is needed to
answer my question. I still have to update my comments, sorry.

Sub AddRow2()

Dim oTbl As Table
Set oTbl = Selection.Tables(1)

response = MsgBox("Would you like to Add a new row?", vbQuestion +
vbYesNo)

If response = vbYes Then

ActiveDocument.Unprotect


' Disable the AddRow macro that is currently in the last cell
' (since we're creating a new last cell)

Selection.Tables(1).Cell(Selection.Tables(1).Rows.Count,
Selection.Tables(1).Columns.Count).Range.FormFields(1).ExitMacro = ""

Selection.InsertRowsBelow 1
Selection.Collapse (wdCollapseStart)
myRow = Selection.Information(wdStartOfRangeRowNumber)

Selection.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
'Selection.SelectCell
Selection.Bookmarks.Add Name:="a1temp", Range:=Selection.Cells(1)

myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text1row" & myRow
.Enabled = True
End With
Selection.Bookmarks.Add Name:="a1temp", Range:=Selection.Range

Selection.MoveRight Unit:=wdCell
Selection.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text2row" & myRow
.Enabled = True
End With

Selection.MoveRight Unit:=wdCell
Set myField3 = Selection.FormFields.Add(Range:=Selection.Range,
Type:=wdFieldFormDropDown)
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text3row" & myRow
.Enabled = True
With myField3.DropDown.ListEntries
.Add Name:=" "
.Add Name:=" Files "
.Add Name:=" Object "
.Add Name:=" Report "
End With
End With

Selection.MoveRight Unit:=wdCell
Selection.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text4row" & myRow
.Enabled = True
End With

Selection.MoveRight Unit:=wdCell
Set myField5 = Selection.FormFields.Add(Range:=Selection.Range,
Type:=wdFieldFormDropDown)
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text5row" & myRow
.Enabled = True
With myField5.DropDown.ListEntries
.Add Name:=" "
.Add Name:=" Promote "
.Add Name:=" Restore "
.Add Name:=" Delete "
End With
End With

Selection.MoveRight Unit:=wdCell
Selection.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text6row" & myRow
.Enabled = True
End With

Selection.MoveRight Unit:=wdCell
Selection.FormFields.Add Range:=Selection.Range,
Type:=wdFieldFormTextInput
myCount = ActiveDocument.Range.FormFields.Count

With ActiveDocument.FormFields(myCount)
.Name = "text7row" & myRow
.Enabled = True
' .ExitMacro = "AddRow2"
End With

oTbl.Cell(oTbl.Rows.Count,
oTbl.Columns.Count).Range.FormFields(1).ExitMacro = "AddRow2"
oTbl.Cell(oTbl.Rows.Count, 1).Range.FormFields(1).Select

ActiveDocument.Protect NoReset:=True, Type:=wdAllowOnlyFormFields

End If

End Sub
 
G

Greg Maxey

Here is a generic macro that should duplicate your first row with as many
rows as you want:

Sub NewRow()
Dim pTable As Word.Table
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim oRng3 As Word.Range
Dim rowsToAdd As Long
Dim oFormField As Word.FormField
Dim bCalcFlag As Boolean
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Set pTable = Selection.Tables(1)
'Ensure no execution except for last row
If Selection.Information(wdStartOfRangeRowNumber) <> pTable.Rows.Count Then
Selection.FormFields(1).ExitMacro = ""
Exit Sub
End If
On Error GoTo Err_Handler
rowsToAdd = InputBox("Enter the number of rows you want to add.", "Add
Rows", 1)
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
For rowsToAdd = rowsToAdd To 1 Step -1
bCalcFlag = False
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
Set oRng3 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
Set oRng2 = pTable.Rows(pTable.Rows.Count).Range
For i = 1 To oRng1.FormFields.Count
oRowID = pTable.Rows.Count
Set oFormField = oRng1.FormFields(i)
With oFormField
If .Type = wdFieldFormTextInput Then
If Not bCalcFlag And .TextInput.Type = 5 Then
bCalcFlag = True
MsgBox "You must edit expressions in any new calculation fields."
End If
End If
End With
oRng2.FormFields(i).Select
With Dialogs(wdDialogFormFieldOptions)
pNewName = oRng3.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_")
If pNameSeparator > 0 Then
pNewName = Left(pNewName, pNameSeparator - 1)
End If
.Name = pNewName & "_" & oRowID
.Execute
End With
Next
pTable.Rows.Last.Previous.Cells(pTable.Rows.Last.Previous.Cells.Count).Range.FormFields(1).ExitMacro
= ""
pTable.Rows.Last.Cells(1).Range.Fields(1).Result.Select
Next
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Exit Sub
Err_Handler:
MsgBox "Canceled by user."
End Sub
 
G

Greg Maxey

This one has a little better process around the input box.
Sub NewMultiRow()
Dim pTable As Word.Table
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim oRng3 As Word.Range
Dim userInput As String
Dim rowsToAdd As Long
Dim oFormField As Word.FormField
Dim bCalcFlag As Boolean
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Set pTable = Selection.Tables(1)
'Ensure no execution except for last row
If Selection.Information(wdStartOfRangeRowNumber) <> pTable.Rows.Count Then
Selection.FormFields(1).ExitMacro = ""
Exit Sub
End If
On Error GoTo Err_Handler
TryAgain:
userInput = InputBox("Enter number of rows to add", "Add Rows", 1)
If Not IsNumeric(userInput) Then
If userInput = "" Then
MsgBox "Canceled by user"
Exit Sub
End If
MsgBox "You did not Enter a Number."
GoTo TryAgain
Else
rowsToAdd = CLng(userInput)
End If
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
For rowsToAdd = rowsToAdd To 1 Step -1
bCalcFlag = False
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
Set oRng3 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
Set oRng2 = pTable.Rows(pTable.Rows.Count).Range
For i = 1 To oRng1.FormFields.Count
oRowID = pTable.Rows.Count
Set oFormField = oRng1.FormFields(i)
With oFormField
If .Type = wdFieldFormTextInput Then
If Not bCalcFlag And .TextInput.Type = 5 Then
bCalcFlag = True
MsgBox "You must edit expressions in any new calculation fields."
End If
End If
End With
oRng2.FormFields(i).Select
With Dialogs(wdDialogFormFieldOptions)
pNewName = oRng3.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_")
If pNameSeparator > 0 Then
pNewName = Left(pNewName, pNameSeparator - 1)
End If
.Name = pNewName & "_" & oRowID
.Execute
End With
Next
pTable.Rows.Last.Previous.Cells(pTable.Rows.Last.Previous.Cells.Count).Range.FormFields(1).ExitMacro
= ""
pTable.Rows.Last.Cells(1).Range.Fields(1).Result.Select
Next
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub
 
A

AltNrg4U

Greg,
I thank you sooo much for your posts. I have been tied down with other
emergencies. I am going to review your code now. Your time, effort,
and help is greatly appreciated.

Keith
 
G

Greg Maxey

Keith,

My pleasure. I had put together code to add a single row a few months
back using a process of copying the current row with its contents to
the new row (a tip from regular newsgroup contributor Jezebel). Your
question prompted me to see if I could revise that code to add multiple
rows.

It seems to be working (subject to very limited testing).
 
A

AltNrg4U

Greg,
All I can say is thank you, thank you, thank you!
For whatever reason, I could not get anybody elses code to work before.
I was having a hard time identifying why certain parts would not run.

Your code is running as smooth as butter for me! For those that
follow, I want to annotate a couple items I had to tweak.
1. I copied your second bit of code, as you said you like the input
process better.
2. Of course you always have to correct problems where the line
wrapped.
3. I have no idea why it happens, but whenever I paste the code into
my VBA editor, the sixth line up places a dash in the word Range. This
happens everytime, but does not occure when I paste it into Outlook
Notes which accepts no formatting.
4. Lastly, you have an on error message that references a line that
does not exist. Thankfully it existed in the one you presented first.
So I copied the last three lines from your first posting and corrected
my End Sub statement to an Exit Sub statement.

As I am anal, I have one last question for you. It took me a long time
to figure out the issue, and maybe you can tell me if anything can be
done about it.

Question: Whenever I TAB out of the last cell, it activates the "on
exit" macro (in this case your macro). AFTER the macro is run, it then
completes the tab request and the focus ends up in the 2nd cell of the
last line. If I use any of the curser keys, or mouse into a form
field, the focus ends up on the 1st cell of the last line. (Oddly
enough, by using the mouse and selecting a part of the form that is not
a field, it will go to the next form field, and not activate the "on
exit" macro.)
I am fully willing to live with the issue, I was just wondering if I
have to, or if anything can be done.
 
G

Greg Maxey

Keith,

Thanks.

Yes the On Error GoTo Err_Handler was left over from the old InputBox
process. Using that code if the user entered and no numeric value or
pressed cancel a type mismatch error was generated. You can remove the
On Error line and the other code associated with it.

I confirm your observation with the "-" in the Range word when pasted
in the VB Editor. I don't know what is causing that.

I am not seeing the same problem wrt the formfield that takes the focus
after the on exit macro runs. Here it is the first formfield in the
last row regardless how I exit the field.

That said, there is some inefficiecy in that part of the code that we
should clear up and a better method of setting the focus:

Remove the current line that reads:

pTable.Rows.Last.Cells(1).Range.Fields(1).Result.Select

and add this code:

Dim oBmName As String
oBmName = pTable.Rows.Last.Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select

following the line that reads:

ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True

This elimnates setting the focus to new intermediate rows when
multirows are added and may solve your focus problem. After you test
this then you can of course move the Dim oBmName As String line to the
top of the procedure with your other declaration statements.

If this doesn't work, you might try adding a slight (few milli-second)
pause in the code just before the statements altered above.

Let me know how it works out.
 
A

AltNrg4U

Greg,
I am going to try this one more time. I have submitted a reply twice.
For some reason, I am getting a notice that it is submitted, but it
never shows up.

Anyway, your suggestion does not appear to work for me. For some
reason it changes my focus to a table above my current one (the first
one in my section). I would work to correct this issue, but it still
ends up in the second cell of the row, and not the first.

I then tried to 'pause' the macro in a variety of places. I used the
first two of Microsoft's suggestions.
http://support.microsoft.com/kb/q162150/ -- "How to Implement a
Delay in Visual Basic for Applications"
This did not appear to have any discernable effect.

I did want to reply, because you requested. I believe the issue is
with my system / configuration so I will not worry about this issue any
further.
__________________________________________________________________________________________

After some thought I realized that I need to have the ability to delete
rows. I am working on having it delete all rows that do not have any
data in the first cell (text formfield). If I am able to complete
that, I will post it as well.

I am trying this approach for two reasons.
1. In case someone accidentally runs the macro (from a macro field at
the top right of my table), I don't want to accidentally delete data.
2. Even if I delete it one row at a time, it is still (remotely)
possible to delete data. If my approach can be created, it will
prevent any deletion of data.

I am taking one additional precaution by ensuring that the macro only
affects the correct table, by going to a bookmark first. I have
enclosed the start of my macro below. "It was using the 'lastrow'
command, but I will have to change that.

Thanks again for all of your help.
Keith
 
A

AltNrg4U

Sub DeleteLastRow()

Dim oTable As Word.Table

'If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect

Selection.GoTo What:=wdGoToBookmark, Name:="CrystalReportsStart"
Set oTbl = Selection.Tables(1)

oTbl.Rows.Last.Delete

ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub
 
G

Greg Maxey

Keith,

OK. I don't have anything else to offer on that problem. I have been
refining the code a bit over the past few days based on some comments
by a few folks that really understand VBA ;-).
The most significant change is added row formfield naming. The code
you have now would clip

Text1_Price appearing in row 1 and make it:

Tex1_2 in row 2

Text1_3 in row 3 etc,

I have revised that to produce:

Text1_Price_Row2
Text1_Price_Row3

I will post the lastest version here this evening when I get home.
 
G

Greg Maxey

My latest version of the code discussed here:

Sub NewMultiRow()
Dim pTable As Word.Table
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim userInput As String
Dim rowsToAdd As Long
Dim oFormField As Word.FormField
Dim bCalcFlag As Boolean
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Dim oBmName As String
Set pTable = Selection.Tables(1)
'Ensure execution stops if "NewMultiRow" is fired from a row other than
current last row
If Selection.Information(wdStartOfRangeRowNumber) <> pTable.Rows.Count Then
Selection.FormFields(1).ExitMacro = ""
Exit Sub
End If
'Set rows to add
TryAgain:
userInput = InputBox("Enter number of rows to add", "Add Rows", 1)
If Not IsNumeric(userInput) Then
If userInput = "" Then
MsgBox "Canceled by user"
Exit Sub
End If
MsgBox "You must use a numeric input e.g." & Chr(34) & "3" & Chr(34)
GoTo TryAgain
Else
rowsToAdd = CLng(userInput)
End If
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
bCalcFlag = False
For rowsToAdd = 1 To rowsToAdd
Set oRng1 = pTable.Rows(pTable.Rows.Count).Range
Set oRng2 = oRng1.Duplicate
With oRng1
.Copy
.Collapse Direction:=wdCollapseEnd
.Paste
End With
For i = 1 To oRng1.FormFields.Count
oRowID = pTable.Rows.Count
'Build and assign formfield bookmark names
oRng1.FormFields(i).Select
With Dialogs(wdDialogFormFieldOptions)
'Build name
pNewName = oRng2.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_")
If pNameSeparator > 0 And InStr(pNewName, "Row") > 0 Then
pNewName = Left(pNewName, InStr(pNewName, "Row") - 2)
End If
.Name = pNewName & "_Row" & oRowID
'Prevent assigning an existing bookmark name.
If ActiveDocument.Bookmarks.Exists(pNewName & "_Row" & oRowID) Then
MsgBox "Invalid action. A form field with the bookmark name " _
& pNewName & "_" & oRowID _
& " already appears this table. Exiting this procedure."
pTable.Rows.Last.Delete
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Exit Sub
End If
'Assign valid bookmark name to new formfield
.Execute
End With
' Unstet this code if yo want a message indication that calculation fields
' must be manually edited.
' Set oFormField = oRng1.FormFields(i)
' With oFormField
' If .Type = wdFieldFormTextInput Then
' If Not bCalcFlag And .TextInput.Type = wdCalculationText Then
' bCalcFlag = True
' MsgBox "One or more added rows contain calculation fields. " _
' & "You must manually edit your expressions in the new " _
' & "calculation fields."
' End If
' End If
' End With
Next
oRng2.FormFields(i - 1).ExitMacro = ""
Next
oBmName = pTable.Rows.Last.Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
If Not bCalcFlag Then
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Else
MsgBox "This form has not been protected. Protect this form after" _
& " you have edited all appropriate calculation fields."
End If
End Sub
 
K

Keith

Greg,
Thanks for the cleaner code. I am using this new code now.

I am enclosing a method I have for deleting the last row for others
that may follow. I have not found a good method for reading the first
cell, but when I do, I will be complete. That would be the last
conditional statement (ok, code) I will have to add. I did add a
condition so that the entire table could not be deleted. It will not
delete my heading row, and my first data row.
_________________________________________________________
Sub DeleteLastRow()

Dim oTable As Word.Table
Dim CrystalReportsTable As Word.Table

If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Selection.GoTo What:=wdGoToBookmark, Name:="CrystalReportsTable"
Set oTbl = Selection.Tables(1)

If Selection.Tables(1).Rows.Count > 2 Then
oTbl.Rows.Last.Delete

Selection.Tables(1).Rows.Last.Cells(Selection.Tables(1).Rows.Last.Cells.Count).Range.FormFields(1).ExitMacro
= "NewMultiRow2"
End If

oTbl.Rows.Last.Select

ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True

End Sub
 
G

Greg Maxey

Keith,

I don't follow your declaration "DIM" statements.

Consider:
Sub DeleteLastRow()
Dim oTbl As Word.Table
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
Selection.GoTo What:=wdGoToBookmark, Name:="CrystalReportsTable"
Set oTbl = Selection.Tables(1)
If oTbl.Rows.Count > 2 Then
oTbl.Rows.Last.Delete
oTbl.Rows.Last.Cells(oTbl.Rows.Last.Cells.Count).Range.FormFields(1).ExitMacro
= "NewMultiRow"
End If
oTbl.Rows.Last.Select
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub
 
K

Keith

Greg,
That works great!

** Chuckle ** There is a reason that your are confused about my DIM
statement. I am guessing at what snippets are required. :) I
noticed that you returned my code from Selection.Tables(1) back to
oTbl. This is great. I had tried it initially, but the setup must
have been incorrect because it wasn't working for me. Your setup works
just fine.

Thanks,
Keith
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top