I need to create duplicate rows in excel for a mail merge

[gpnd03]

Hi,

I need to create duplicate rows in excel for a mail merge in order to print differing number of documents for each row in excel. The table has a certain number of rows (say 100) of unique data. In each row there is a list of addresses that will get a letter. The table has a column called "Count" that has the # of addresses to count the number of documents I need to send for that row of data. To simplify, its something like this:

Headers: Key No. $$ amount Count
Row 1: 71-55 $1000 2
Row 2: 82-66 $4000 3
Row 3: 90-56 $2650 9

So, I need to duplicate row 1 an additional time, row 2 two additional times, and row 3 8 additional times. Or, alternatively if its easier, I need to create a new worksheet that has row 1 two times, row 2 three times, and row 3 nine times. It doesn't really matter what order the duplication is in as I can do a quick sort by key number to put them in the order I need for the mail merge. Duplicating in a new spreadsheet would be ideal.

Because there may be 100 rows and over 500 duplications, I need an automated solution for this. If there is a way to do this in Word where word can read the insert Count in the upper right hand corner and print that number of that document that is also a solution but I think the excel solution would be easiest.

Any help would be much appreciated. Email me at geoff@geoffreypolk.com if you have ideas or need more information on what I'm trying to do here.

Thanks!

Geoff

 

[b.downey]

Try this code:

It asumes that the data, as you describe, is in "Sheet1" and that there is a "Sheet2" available to place the results

Option Explicit
Sub Dup()
    Dim Wb As Workbook
    Dim WsSrc As Worksheet
    Dim WsDst As Worksheet
    Dim RowNo As Long
    
    Dim DstRowNo As Long
    Dim Cnt As Integer
    Dim I As Integer
    
    Set Wb = ThisWorkbook
    Set WsSrc = Wb.Worksheets("Sheet1")
    Set WsDst = Wb.Worksheets("Sheet2")
    
    WsDst.Cells.ClearContents
    
    DstRowNo = 2
    WsSrc.Rows(1).Copy (WsDst.Rows(1))
    For RowNo = 2 To WsSrc.Cells(WsSrc.Rows.Count, "A").End(xlUp).Row
        Cnt = WsSrc.Cells(RowNo, "C")
        WsSrc.Rows(RowNo).Copy
        For I = 1 To Cnt
            Debug.Print RowNo, DstRowNo
            WsDst.Rows(DstRowNo).PasteSpecial
            DstRowNo = DstRowNo + 1
        Next I
    Next RowNo
End Sub

 

[gpnd03]

Thanks for the help! How and where do I input this code to test it?

Try this code:

It asumes that the data, as you describe, is in "Sheet1" and that there is a "Sheet2" available to place the results

Option Explicit
Sub Dup()
    Dim Wb As Workbook
    Dim WsSrc As Worksheet
    Dim WsDst As Worksheet
    Dim RowNo As Long
    
    Dim DstRowNo As Long
    Dim Cnt As Integer
    Dim I As Integer
    
    Set Wb = ThisWorkbook
    Set WsSrc = Wb.Worksheets("Sheet1")
    Set WsDst = Wb.Worksheets("Sheet2")
    
    WsDst.Cells.ClearContents
    
    DstRowNo = 2
    WsSrc.Rows(1).Copy (WsDst.Rows(1))
    For RowNo = 2 To WsSrc.Cells(WsSrc.Rows.Count, "A").End(xlUp).Row
        Cnt = WsSrc.Cells(RowNo, "C")
        WsSrc.Rows(RowNo).Copy
        For I = 1 To Cnt
            Debug.Print RowNo, DstRowNo
            WsDst.Rows(DstRowNo).PasteSpecial
            DstRowNo = DstRowNo + 1
        Next I
    Next RowNo
End Sub

 

[gpnd03]

Its giving me an error of subscript out of range. Any ideas on how to debug that?

 

[b.downey]

Typically this is due to a few different issues. Please Check the following:

You need to have two Sheets, one named "Sheet1" and the other "Sheet2" as described in the original post

Also, Can you tell me what line is creating the issue?

 

[gpnd03]

I got it to work, just had to add a space between sheet and the number and change the column number to the correct one for count (not C) in the actual sheet. Thanks again!

 

[b.downey]

No Problem. Thanks for the response!