MailMerge with several repetitions of a single record

[LoftySuth]

I have an excel file containing a list of 13 digit EAN barcodes.
I have a word document set up to a label size. The EAN font has been added.
What I want to do is have my user choose the required EAN code and the number of labels.
I have tried mailmerge, and that will print me one copy of the bar code. How do I get say 8 labels with the same code?
Lofty

[gmayor]

It would be a bit fiddly to do with mail merge, especially if the requirement for code and number of labels was going to change each time. You would need to create a VBA process to provide the results you require.

While you are thinking about a VBA process, you could investigare a barcode tool availablefrom my web site - http://www.gmayor.com/bar_coded_labels.htm which may suit your needs.

If the label only has a bar code, then although not designed with this application in mind, you could also use your data file with the http://www.gmayor.com/Envelope_Label_Add_In.htm and thus select the bar codes you wish and write as many of each as you wish to the label sheet.

[LoftySuth]

gmayor,
Thanks for your interest. Rather than a packaged answer to my question I was hoping for some help with the coding I thought would be needed. I am used to using VBA with excel but never before with word. I have got the following code (By recording a macro)

Sub Merge()

    ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "U:\EVERYBODY!\Antalis\Antalis_BarCodes.xlsx", ConfirmConversions:=False, _
         ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=U:\EVERYBODY!\Antalis\Antalis_BarCodes.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Loc" _
        , SQLStatement:="SELECT * FROM `BARCODES$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    Selection.TypeText Text:=" "
    Selection.TypeParagraph
    
    Selection.Font.Name = "EAN-13"
    Selection.Font.Size = 72
    Selection.TypeText Text:="   "
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
        "BASE_EAN_CODE"
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub

I have not been able to find any references about repeating a label, nor is it obvious where it would go in the code above.
Can you point me in the direction I should take to progress further?
Lofty

[macropod]

If the mailmerge data source has a field that indicates how many labels are required for each record, and the datasource is an Excel workbook the user is allowed to modify, the following macro can be used to duplicate the worksheet and replicate as many rows as are needed there for each label. With this macro, the user can specify: the sheet name for the current data; the sheet name to be used as the mailmerge datasource; and the column # containing the labels, via the Data_Sheet, MergeSheet and LblCol parameters, respectively.

With this approach, you'd do the normal setup for the mailmerge main document, then run the macro below before doing the mailmerge. Because this approach uses a different worksheet than the data sheet for the actual merge, it requires you to create that worksheet, with all the column headings, before you specify the mailmerge data source. You can delete that sheet afterwards, if you want.

Sub MultiLabelMergeSetup()
Application.ScreenUpdating = False
Dim xlWkShtSrc As Worksheet, xlWkShtTgt As Worksheet
Dim i As Long, j As Long, k As Long, l As Long
Dim lRow As Long, lCol As Long, LblCol As Long
Const Data_Sheet As String = "Sheet1"
Const MergeSheet As String = "Sheet2"
With ActiveWorkbook
  Set xlWkShtSrc = .Sheets(Data_Sheet)
  If SheetExists(ActiveWorkbook, MergeSheet) = True Then
    Set xlWkShtTgt = .Sheets(MergeSheet)
    xlWkShtTgt.UsedRange.Clear
  Else
    Set xlWkShtTgt = .Worksheets.Add(After:=xlWkShtSrc)
    xlWkShtTgt.Name = MergeSheet
  End If
  xlWkShtSrc.UsedRange.Copy
  xlWkShtTgt.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  With xlWkShtTgt.UsedRange
    .WrapText = False
    .Columns.AutoFit
    lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
    lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
    LblCol = lCol ' If the label #s aren't in the last column, specify the column index # here
    For i = lRow To 2 Step -1
      j = .Cells(i, lCol).Value: l = j
      If j > 1 Then
        .Range(.Cells(i, 1), .Cells(i, lCol)).Copy
        .Range(.Cells(i, 1), .Cells(i + j - 2, lCol)).Insert Shift:=xlShiftDown
        For k = i + j - 1 To i Step -1
          .Cells(k, LblCol).Value = l
          l = l - 1
        Next
      End If
    Next
  End With
End With
Set xlWkShtSrc = Nothing: Set xlWkShtTgt = Nothing
Application.ScreenUpdating = True
End Sub
 
Function SheetExists(SheetName As String) As Boolean
Dim i As Long: SheetExists = False
For i = 1 To Sheets.Count
  If Sheets(i).Name = SheetName Then
    SheetExists = True:   Exit For
  End If
Next
End Function

[LoftySuth]

Macropod,
Thanks very much for your interest and help!
Unfortunately I am having problems with your code because 1Col takes on the value of a 13 digit barcode (in the last column of the table).
However A thought triggered by your code led me to the idea of using a table consisting solely of a column of the required number of repetitions of the needed barcode.
As a data source for a manual mail merge ,this works.
I find I have still another problem though, which is how to automate the mail merge in Word.
I can create code by recording a macro, but I cant find a way of triggering this code from Excel or even from within Word. If I manually open the Word document containing the code I get the message to confirm the data source but nothing further happens until I go through the merge manually.
Can you help me further? Ideally, I want to have my user open the excel Workbook
choose the bar code and the number of labels required(this I have successfuly coded), then move seamlessly from Excel into the Word document and complete the label printing.
John

[macropod]

Originally Posted by LoftySuth

Unfortunately I am having problems with your code because 1Col takes on the value of a 13 digit barcode (in the last column of the table).

In that case, edit the code as per the comments on this line:
LblCol = lCol ' If the label #s aren't in the last column, specify the column index # here

Originally Posted by LoftySuth

I can create code by recording a macro, but I cant find a way of triggering this code from Excel or even from within Word. If I manually open the Word document containing the code I get the message to confirm the data source but nothing further happens until I go through the merge manually.
Can you help me further? Ideally, I want to have my user open the excel Workbook
choose the bar code and the number of labels required(this I have successfuly coded), then move seamlessly from Excel into the Word document and complete the label printing.

The macro I've posted is designed to be run from Excel, so that part of the setup is already taken care of. To execute the merge from Excel, though, you need to automate Word. For code to do that, see the discussion in: https://www.msofficeforums.com/mail-...ail-excel.html