Word AddAsk and Reference Help

[Martin]

I am trying to write two macros for Word to assist in the writing of minutes
and the construction of an action table.

Whilst typing the minutes, the user runs the AddAction Sub when he / she
wants to insert an action. Then, the user is then asked two questions - who
is the owner of the action and what is the action itself. Their responses
should appear at the current position in the text, along with some additional
text and formatting.

Once the user has completed the minutes, he / she runs the ActionTable Sub.
This sub consists of several components - one to copy the table from last
week’s minutes (from Section 2 of the document to Section 4), then to add, by
referencing, all the owners and actions that the user has inserted in the
minutes (from Section 3), and finally to remove the resolved actions and tidy
up the table.

Below is a sample minutes document and the code that I have written so far.
Everything is working nicely except the AddAction and AddNewAction subs. I
have been working on the assumption that the easiest way to achieve the
desire result is to use AddAsk’s and REFs, but I would welcome other
suggestions and any corrections to my obviously incorrect code.

=======================================

Header Info



Owner Action Status
KF X-mas shopping Resolved
AS X-mas shopping Ongoing
KF Cooking Pending
AS Cleaning mud off the floor!
KF Laundry
KF Dry Cleaning Resolved



Text of Minutes

==========================================


Sub AddAction()

Selection.Font.Bold = wdToggle
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
Selection.TypeText Text:="Action:"
Selection.Font.Bold = wdToggle
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
Selection.TypeText Text:=" "

ReDim aMarks(ActiveDocument.Bookmarks.Count)
i = 1

With ActiveDocument.Bookmarks
.Add (aMarks(i))
End With

ActiveDocument.MailMerge.Fields.AddAsk Range:=Selection.Range,
Prompt:="Owner?", Name:=aMarks(i)

i = i + 1

Selection.TypeText Text:=" to "

ActiveDocument.MailMerge.Fields.AddAsk Range:=Selection.Range,
Prompt:="Action?", Name:=aMarks(i)

With ActiveDocument.Bookmarks
.Add (aMarks(i))
End With


End Sub
Sub ActionTable()
Call CopyOldTable
Call AddNewActions
Call FormatFinalTable

End Sub

Sub CopyOldTable()
Selection.GoTo what:=wdGoToSection, Which:=wdGoToFirst, Count:=2, Name:=""
If ActiveDocument.Tables.Count >= 1 Then _
ActiveDocument.Tables(1).Range.Copy
Selection.GoTo what:=wdGoToSection, Which:=wdGoToFirst, Count:=4, Name:=""
Selection.Paste

Dim oRow As Row
Dim oCell As Cell
Dim sCellText As String

For Each oRow In ActiveDocument.Tables(2).Rows

For Each oCell In oRow.Cells
sCellText = oCell.Range
sCellText = Left$(sCellText, Len(sCellText) - 2)
If sCellText = "Resolved" Then
oRow.Delete
End If

Next oCell

Next oRow


End Sub

Sub AddNewActions()
Selection.GoTo what:=wdGoToSection, Which:=wdGoToFirst, Count:=4, Name:=""
Selection.GoTo what:=wdGoToTable, Which:=wdGoToFirst, Count:=2, Name:=""
Selection.EndKey Unit:=wdColumn
Selection.EndKey Unit:=wdRow
Selection.MoveRight Unit:=wdCell
myOtherRange = ActiveDocument.Sections(3)
ReDim aMarks(myOtherRange.Bookmarks.Count)
myRange = ActiveDocument.Tables(2)
For Each aMarks In myOtherRange
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:= _
"REF aMarks(i)", PreserveFormatting:=False
Selection.EndKey Unit:=wdColumn
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:= _
"REF aMarks(i+1)", PreserveFormatting:=False
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Next

End Sub
Sub FormatFinalTable()
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1",
SortFieldType _
:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending,
FieldNumber2 _
:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending,
Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False,
LanguageID _
:=wdEnglishUK
End Sub