Microsoft Office Forums - View Single Post - Directory MailMerge with Category Grouped Lists on Labels

macropod · 06-18-2014, 11:41 PM

FWIW, an alternative approach would be to forget about using Word and doing the lot from within Excel. For example, the following macro creates all your labels on Sheet 2 of your existing workbook:

Code:

Sub Demo()
Dim lRow As Long, lCol As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long
Dim WkShtSrc As Worksheet, WkShtTgt As Worksheet
k = 0
Set WkShtSrc = ThisWorkbook.Worksheets("Sheet1")
Set WkShtTgt = ThisWorkbook.Worksheets("Sheet2")
With WkShtTgt
  .UsedRange.ClearContents
  .Columns("B:D").ColumnWidth = 43.3
  .Columns("A").ColumnWidth = 10
  .Columns("C").ColumnWidth = 10
  .Rows.RowHeight = 240
  With .Columns("A:D").Font
    .Name = "Arial"
    .Size = 12
  End With
End With
With WkShtSrc
  lRow = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
  lCol = .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Column
  For i = 2 To lRow
    If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
      With WkShtTgt.Cells(m, l)
        .Value = .Text & Chr(10)
        For j = 2 To lCol
          .Value = .Text & Chr(10) & WkShtSrc.Cells(i, j)
        Next
      End With
    Else
      l = (k Mod 2 + 1) * 2: k = k + 1: m = -Int(-k / 2)
      With WkShtTgt.Cells(m, l)
        .Value = "BOX " & WkShtSrc.Cells(i, 1) & Chr(10)
        For j = 2 To lCol
          .Value = .Text & Chr(10) & WkShtSrc.Cells(i, j)
        Next
      End With
    End If
  Next
End With
End Sub

You will probably need to adjust the sheet margins and, perhaps, the values used for the columns A & C widths to get the exact alignment you require but, once that's done, there's no need to involve Word.