Hi friends.

I work for a mesothelioma law firm. Our database outputs excel sheets according to templates and word documents according to templates, but certain sets of data can't be pulled into the Word templates. Thus, I have built a macro that will take sorted and categorized data from an excel sheet and insert them into the word document.

This solution is far from graceful, and I would like something more robust. The select-between-bookmarks approach I've used also seems to be working inconsistently. Sometimes a { NEXT } field will be moved and it will throw off my mailmerge.

I've considered using the directory mailmerge, but I have been unable to format results correctly. If anyone has any suggestions on how to do this better, I would appreciate them greatly.

Here are the documents:

Template Export.docx
Database Export.xlsx

For this example, I have a sheet with 56 total defendants, 17 product defendants, and 39 premise defendants. At the bottom of the post is the macro. Just download the two files, select the Mailmerge tab as an existing mailmerge list, and then run the macro.

Here's a brief description of how it works:
  • I use fields like { MERGEFIELD {SEQ list1 }} so I can cut and paste sections depending on a number, say, a number of defendants. After all the fields are updated, the mailmerge pulls from the correct column sequentially.
  • For some sections, the macro copies a bookmark and pastes it a number of times according to user input.
  • For other sections, I use bookmarks to frame a section that need to be repeated. The macro selects the area between the bookmark and pastes a number of times according to user input.
  • Between sections I use the { NEXT } command to change the row. For example, the first and second lists include all defendants. The third list is only premise defendants.


Code:
Sub complaintgenerate()
'
'
'If error, skip to end.
    '
    '
    'User inputs TOTAL number of defendants
        Dim totalDef As Integer
        totalDef = InputBox("How many defendants TOTAL?", "Add TOTAL Defendant List")
    '
    '
    'User inputs number of PRODUCT defendants
        Dim productNumber As Integer
        productNumber = InputBox("How many PRODUCT defendants?", "Add Negligence Sections")
    '
    '
    'User inputs number of PREMISE defendants
        Dim premiseNumber As Integer
        premiseNumber = InputBox("How many PREMISE defendants?", "Add Premise Sections")
    '
    '
    'Subtract 1 from Total Number
        Dim totalMinus1 As Integer
        totalMinus1 = totalDef - 1
    '
    '
    'Subtract 2 from Total Number
        Dim totalMinus2 As Integer
        totalMinus2 = totalDef - 2
    '
    '
    'Subtract 2 from Product Number
        Dim productNumberMinus2 As Integer
        productNumberMinus2 = productNumber - 2
    '
    '
    'Subtract 2 from Product Number
        Dim premiseNumberMinus2 As Integer
        premiseNumberMinus2 = premiseNumber - 2
    '
    '
    'Insert Full List in Caption
        Selection.GoTo What:=wdGoToBookmark, Name:="listmark"
        Selection.Copy
        Selection.MoveRight Unit:=wdCell
        Selection.MoveRight Unit:=wdCell
        Selection.MoveRight Unit:=wdCell
            Dim x As Long
                For x = 1 To totalMinus2
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                    Selection.MoveRight Unit:=wdCell
                    Selection.TypeText Text:=")"
                    Selection.MoveRight Unit:=wdCell
                    Selection.MoveRight Unit:=wdCell
                Next x
    '
    '
    'Insert List in Count 1: Negligence
        Selection.GoTo What:=wdGoToBookmark, Name:="negList"
        Selection.Copy
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:=" "
            Dim o As Long
                For o = 1 To totalMinus1
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                    Selection.TypeText Text:=" "
                Next o
    '
    '
    'Insert Product Repeating Counts
        Selection.GoTo What:=wdGoToBookmark, Name:="productSTART"
        Selection.ExtendMode = True
        Selection.GoTo What:=wdGoToBookmark, Name:="productEND"
        Selection.Copy
        Selection.MoveDown Unit:=wdLine, Count:=1
            Dim i As Long
                For i = 1 To productNumberMinus2
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                Next i
    '
    '
    'Premise Repeating Counts
        Selection.GoTo What:=wdGoToBookmark, Name:="premiseSTART"
        Selection.ExtendMode = True
        Selection.GoTo What:=wdGoToBookmark, Name:="premiseEND"
        Selection.Copy
        Selection.MoveDown Unit:=wdLine, Count:=1
            Dim f As Long
                For f = 1 To premiseNumberMinus2
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                Next f
    '
    '
    'Insert Consortium List
        Selection.GoTo What:=wdGoToBookmark, Name:="consortiumlist"
        Selection.Copy
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeText Text:=" "
            Dim c As Long
                For c = 1 To totalMinus1
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                    Selection.TypeText Text:=" "
                Next c
    '
    '
    'Insert "Certain Facts" List
        Selection.GoTo What:=wdGoToBookmark, Name:="lastList"
        Selection.Copy
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
            Dim q As Long
                For q = 1 To totalMinus1
                    Selection.PasteAndFormat (wdFormatOriginalFormatting)
                    Selection.TypeParagraph
            Next q
    '
    '
    'Select all, update fields
        Selection.WholeStory
        Selection.Fields.Update
    '
    '
    '
    'MailMerge
         With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
         With .DataSource
                .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
                .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            End With
            .Execute Pause:=False
         End With
    'Complete!
        MsgBox ("Complete!")
    '
    '
End Sub