Help needed: Repeat form variable number of times as determined by the user

[Grant8587]

I've come a bit stuck, and to be honest don't even know where to start with this problem having only done basic vba before.

The situation I have is a very simple template in word, created in the form of a table just one column across. It goes header (question) then free space to answer on the next row, back to question and so on.

The complication is there are 2 sections of the form that need to be filled out between 1 and 10 times, I.e. duplicate those parts of the template up to 10 times.

So far I'm relying on bookmarks with a macro that hides and unhides duplicate sections of the form as and when they are needed, but it is ungainly and easy for the user to delete the field that calls up the next part of the form.

What I ideally want, is a field where the user determines the number of duplicates they need then a piece of VBA code to run on exit of this field and create the template in the desired way.

Any help would be much appreciated!

[gmaxey]

You can probably adapt this code:

Sub NewMultiRow()
Dim pTable As Word.Table
Dim bValid As Boolean
Dim curCursor As Long
Dim bCalcField As Boolean
Dim oRng1 As Word.Range
Dim oRng2 As Word.Range
Dim userInput As String
Dim rowsToAdd As Long
Dim rowAdd As Long
Dim oFF As Word.FormField
Dim oRowID As Long
Dim i As Long
Dim pNewName As String
Dim pNameSeparator As Long
Dim pRowIndex
Dim oBmName As String
Set pTable = ActiveDocument.Tables(1) 'As appropriate
'Use Selection.Tables(1) if executing with an on exit macor
'Get user input of rows to add
bValid = False
Do
userInput = InputBox("Enter number of rows to add", "Add Rows", 1)
If userInput = vbNullString Then Exit Sub
If userInput = "0" Then Exit Sub
If IsNumeric(userInput) Then rowsToAdd = CLng(userInput)
If rowsToAdd > 0 Then bValid = True
If Not bValid Then
MsgBox "You must use a positve numeric input e.g." & Chr(34) & "3" & Chr(34)
End If
Loop Until bValid
'Minimize screen flicker
curCursor = System.Cursor
System.Cursor = wdCursorWait
Application.ScreenUpdating = False
'Determine if calculation fields are present and set a flag
On Error GoTo Err_Handler
Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).Range '2 accounts for the trailing rows
bCalcField = False
For i = 1 To oRng1.FormFields.Count
If oRng1.FormFields(i).TextInput.Type = wdCalculationText Then
bCalcField = True
Exit For
End If
Next i
'Unprotect document.
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
End If
'Add individual rows
For rowAdd = 1 To rowsToAdd
Set oRng1 = pTable.Rows(pTable.Rows.Count - 2).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 - 4 '4 accounts for the two leading and two
'trailing.
'Build and assign formfield bookmark names
oRng1.FormFields(i).Select
'Build new name
pNewName = oRng2.FormFields(i).Name
pNameSeparator = InStr(pNewName, "_Row")
If pNameSeparator > 0 Then
pNewName = Left(pNewName, pNameSeparator - 1)
End If
'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(oRowID).Delete
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
Exit Sub
End If
With Dialogs(wdDialogFormFieldOptions)
.Name = pNewName & "_Row" & oRowID
'Assign valid bookmark name to new formfield
.Execute
End With
'This code could be used to clear previous on exit macros if used.
'If oRng2.FormFields(i).ExitMacro = "NewMultiRow" Then
' oRng2.FormFields(i).ExitMacro = ""
'End If
Next
'Call subroutine to build new calculation field
If bCalcField Then
BuildNewCalcFieldExpressions oRng1, oRng2
End If
Next
pRowIndex = pTable.Rows.Count - rowsToAdd + 1 - 2 '2 accounts for the 2 trailing rows
oBmName = pTable.Rows(pRowIndex).Cells(1).Range.Bookmarks(1).Name
ActiveDocument.Bookmarks(oBmName).Range.Fields(1).Result.Select
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'Restore visuals
Application.ScreenUpdating = True
System.Cursor = curCursor
Exit Sub
Err_Handler:
If Err.Number = 5991 Then
MsgBox Err.Description
Else
MsgBox "Unknown error."
End If
End Sub
Sub BuildNewCalcFieldExpressions(ByVal oRng1 As Range, oRng2 As Range)
'Construct any new calculation fields.
Dim oFF As FormField
Dim strOldVar As String
Dim strNewVar As String
Dim strNewCalc As String
Dim ndx As Long
Dim ndx2 As Long
Dim lngVarPosit As Long
Dim lngVarNextPosit As Long
Dim bVariableFound As Boolean
Dim bVariableReplace As Boolean
For ndx = 1 To oRng1.FormFields.Count
Set oFF = oRng1.FormFields(ndx)
If oFF.Type = wdFieldFormTextInput Then
If oFF.TextInput.Type = wdCalculationText Then
strNewCalc = oFF.TextInput.Default
For ndx2 = 1 To oRng2.FormFields.Count
strOldVar = oRng2.FormFields(ndx2).Name
lngVarPosit = 1
Do While lngVarPosit > 0
lngVarPosit = InStr(lngVarPosit, strNewCalc, strOldVar)
bVariableFound = lngVarPosit > 0
bVariableReplace = bVariableFound
If bVariableReplace Then
If lngVarPosit > 1 Then
If Mid$(strNewCalc, lngVarPosit - 1) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
lngVarNextPosit = lngVarPosit + Len(strOldVar)
If lngVarNextPosit <= Len(strNewCalc) Then
If Mid$(strNewCalc, lngVarNextPosit) Like "[0-9A-Z_a-z]" Then
bVariableReplace = False
End If
End If
End If
If bVariableReplace Then
strNewVar = oRng1.FormFields(ndx2).Name
strNewCalc = Left$(strNewCalc, lngVarPosit - 1) & strNewVar & Mid$(strNewCalc, lngVarNextPosit)
lngVarPosit = lngVarPosit + Len(strNewVar)
Else
If bVariableFound Then
lngVarPosit = lngVarPosit + Len(strOldVar)
End If
End If
Loop
Next ndx2
oFF.Select
With Dialogs(wdDialogFormFieldOptions)
.TextDefault = strNewCalc
.Execute
End With
End If
End If
Next ndx
End Sub