Using Mailmerge To Include Grouped Information In a Letter

macropod · #1 06-08-2020, 01:29 AM

Quote:

Originally Posted by Tesla

If possible could you please show me how to add subtotals for each month and general total?

It would have been helpful had you said from the outset that's what you wanted to do. I don't enjoy re-writing code - a considerable amount of which would be required - just to satisfy belated scope creep.

Try replacing the existing macro with:

Code:

Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim s As Long, c As Long, r As Long, t As Long
Dim Tbl As Table, StrRDt As String, StrCDt As String, Rng As Range
Dim u As Long, v As Long, w As Long, x As Long
ActiveDocument.MailMerge.Execute
With ActiveDocument
  For s = 1 To .Sections.Count ' - 1
    Set Tbl = .Sections(s).Range.Tables(1)
    With Tbl
      .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
      .Rows.Alignment = wdAlignRowCenter
      .Rows(1).HeadingFormat = True
      .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
      For c = 3 To 5
        .Columns(c).PreferredWidthType = wdPreferredWidthPoints
        .Columns(c).PreferredWidth = InchesToPoints(1)
      Next
      StrRDt = Split(.Cell(.Rows.Count, 1).Range.Text, vbCr)(0)
      StrRDt = Split(StrRDt, "-")(1) & "-" & Split(StrRDt, "-")(2)
      .Rows.Add: t = .Rows.Count
      For r = t - 1 To 2 Step -1
        StrCDt = Split(.Cell(r, 1).Range.Text, vbCr)(0)
        StrCDt = Split(StrCDt, "-")(1) & "-" & Split(StrCDt, "-")(2)
        If StrRDt = StrCDt Then
          For c = 3 To 5
            Select Case c
              Case 3: u = u + Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
              Case 4: v = v + Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
              Case 5: w = w + Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
            End Select
          Next
        ElseIf (StrRDt <> StrCDt) Or (r = 2) Then
          .Cell(t, 1).Range.Text = StrRDt
          .Rows(t).Range.Font.Italic = True
          For c = 3 To 5
            Select Case c
              Case 3
                .Cell(t, c).Range.Text = Format(u, "£#,##0")
                u = Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
              Case 4
                .Cell(t, c).Range.Text = Format(v, "£#,##0")
                v = Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
              Case 5
                .Cell(t, c).Range.Text = Format(w, "£#,##0")
                w = Split(Split(.Cell(r, c).Range.Text, vbCr)(0), "£")(1)
            End Select
          Next
          StrRDt = StrCDt: t = r + 1
          If r <> 2 Then
            .Rows.Add Tbl.Rows(r + 1)
          Else
            Exit For
          End If
        End If
      Next
      .Cell(t, 1).Range.Text = StrRDt
      For c = 3 To 5
        Select Case c
          Case 3
            .Cell(t, c).Range.Text = Format(u, "£#,##0")
          Case 4
            .Cell(t, c).Range.Text = Format(v, "£#,##0")
          Case 5
            .Cell(t, c).Range.Text = Format(w, "£#,##0")
        End Select
      Next
      .Rows(t).Range.Font.Italic = True
      .Rows.Add: t = .Rows.Count
      For c = 3 To 5
        Set Rng = .Cell(t, c).Range
        Rng.Collapse wdCollapseStart
        Rng.Fields.Add Rng, wdFieldEmpty, "=SUM(ABOVE)/2 \# £,#0", False
      Next
      .Cell(t, 1).Range.Text = "TOTAL:"
      .Rows(t).Range.Font.Bold = True
    End With
    Set Tbl = .Sections(s).Range.Tables(2)
    With Tbl
      .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
      .Rows.Alignment = wdAlignRowCenter
      .Rows(1).HeadingFormat = True
      .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
      StrRDt = Split(.Cell(.Rows.Count, 1).Range.Text, vbCr)(0)
      StrRDt = Split(StrRDt, "-")(1) & "-" & Split(StrRDt, "-")(2)
      .Rows.Add: t = .Rows.Count
      For r = t - 1 To 2 Step -1
        StrCDt = Split(.Cell(r, 1).Range.Text, vbCr)(0)
        StrCDt = Split(StrCDt, "-")(1) & "-" & Split(StrCDt, "-")(2)
        If StrRDt = StrCDt Then
          x = x + Split(Split(.Cell(r, 2).Range.Text, vbCr)(0), "£")(1)
        ElseIf (StrRDt <> StrCDt) Or (r = 2) Then
          .Cell(t, 1).Range.Text = StrRDt
          .Rows(t).Range.Font.Italic = True
          .Cell(t, 2).Range.Text = Format(x, "£#,##0")
          StrRDt = StrCDt: t = r + 1
          If r <> 2 Then
            .Rows.Add Tbl.Rows(r + 1)
          Else
            Exit For
          End If
        End If
      Next
      .Cell(t, 1).Range.Text = StrRDt
      .Cell(t, 2).Range.Text = Format(x, "£#,##0")
      .Rows(t).Range.Font.Italic = True
      .Rows.Add: t = .Rows.Count
      Set Rng = .Cell(t, 2).Range
      Rng.Collapse wdCollapseStart
      Rng.Fields.Add Rng, wdFieldEmpty, "=SUM(ABOVE)/2 \# £,#0", False
      .Cell(t, 1).Range.Text = "TOTAL:"
      .Rows(t).Range.Font.Bold = True
    End With
  Next
  .Fields.Unlink
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

Tesla · #2 06-08-2020, 09:28 AM

Hello again, I am really sorry I am a beginner,

Trying to replace existing macro was also a problem, I don't know how to do it. I went on View-Macros-Edit. When I printed the document, it came as if I did no thing.

Previously I thought I would do subtotals myself on the basis of the tutorial "Using Mailmerge To Create Category-Based Lists", I didn't want to give you the work I can learn to do myself, but the code you developed was different from the code included in the tutorial, so I couldn't know where to insert the code for subtotals and the general total. This is why I didn't express my request previously.

macropod · #3 06-08-2020, 03:34 PM

Quote:

Originally Posted by Tesla

Trying to replace existing macro was also a problem, I don't know how to do it. I went on View-Macros-Edit. When I printed the document, it came as if I did no thing.

Open the mailmerge main document, then press Alt-F11 to open the VBA Editor. Delete the exiting MailMergeToDoc macro and replace it with the one in my previous post, then press Alt-F11 to close the VBA Editor.

Quote:

Originally Posted by Tesla

Previously I thought I would do subtotals myself on the basis of the tutorial "Using Mailmerge To Create Category-Based Lists", I didn't want to give you the work I can learn to do myself, but the code you developed was different from the code included in the tutorial, so I couldn't know where to insert the code for subtotals and the general total. This is why I didn't express my request previously.

The tutorial has complete instructions on how to do that but you never mentioned that as a goal. In any event, as I said a few posts back, you can't do the kind of multi-table merge you want using that approach, let alone a workbook as yours was structured.

Tesla · #4 06-09-2020, 12:23 AM

Quote:

Originally Posted by macropod

Open the mailmerge main document, then press Alt-F11 to open the VBA Editor. Delete the exiting MailMergeToDoc macro and replace it with the one in my previous post, then press Alt-F11 to close the VBA Editor.

I did as instructed above but I don't see "MailMerge ToDoc macro" so that I can replace it. I attach a sreen shot of my computer

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to insert an image to a word mailmerge document based on the value of a mailmerge field?	Jake93	Mail Merge	3	07-02-2019 05:38 PM
Use L and R arrow to move cursor letter to letter, not top of the line	mellowkitten	Word	2	05-12-2016 07:23 PM
How to replace a letter to random letter with different color?	cikanoz87	Word	7	06-18-2015 09:43 PM
Mailmerge with grouped data	Keith Henderson	Mail Merge	14	02-04-2015 01:45 PM
Directory MailMerge with Category Grouped Lists on Labels	screech	Mail Merge	3	06-18-2014 11:41 PM