Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
Hi--I"m trying to print out labels to use on cartons. The data source is an
excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the mail merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#2
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
You would need to create a data source that contains the necessary number of
rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#3
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
I'm still learning VBA in XL, so if someone wants to post a better version of
this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#4
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
I suggest that you post your question to Microsoft.Public.Excel.Programming
-- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Access101" wrote in message ... I'm still learning VBA in XL, so if someone wants to post a better version of this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#5
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
Doug,
My Reply was not a question, it was a solution to T. Neil's question. As well as a response to your statement: "While I am sure that it can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows:" This was the XL version of your Word solution for T. Neil. I was further influenced by the fact that I saw nothing in the Post that was re-directing T. Neil to the Microsoft.Public.Excel.Programming group, so I felt free to post the XL solution in the Word discussion as well. "Doug Robbins - Word MVP" wrote: I suggest that you post your question to Microsoft.Public.Excel.Programming -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Access101" wrote in message ... I'm still learning VBA in XL, so if someone wants to post a better version of this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#6
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
Sorry about that. It's fairly common for posters to change the identity and
I did not look closely enough at your post. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Access101" wrote in message ... Doug, My Reply was not a question, it was a solution to T. Neil's question. As well as a response to your statement: "While I am sure that it can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows:" This was the XL version of your Word solution for T. Neil. I was further influenced by the fact that I saw nothing in the Post that was re-directing T. Neil to the Microsoft.Public.Excel.Programming group, so I felt free to post the XL solution in the Word discussion as well. "Doug Robbins - Word MVP" wrote: I suggest that you post your question to Microsoft.Public.Excel.Programming -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "Access101" wrote in message ... I'm still learning VBA in XL, so if someone wants to post a better version of this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#7
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
Hello Access101,
I was also looking at a way to do this fairly easily in Excel, but am also pretty inexperienced in Excel VBA (and rather less experienced than Doug in Word VBA). In fact I would prefer to avoid VBA altogether if possible, and tried to solve this using Jet SQL, which, given a chance and a bit of additional infrastructure, lets you generate the required table using a single SQL statement. But anyway, the thing I was stuck on was the use of "CurrentRegion" to select the necessary block of data, which your code helped me with. But I think yours can be simplified quite a lot, unless there are problems copying source cells to data cells, or other oddities in the Excel object model that I'm not aware of. Here's my current code with some comments that may help you. But I think Doug's suggestion to follow this up in an Excel group is sound - they will know much more about the Excel object model, constant and variable naming conventions, and so on. They may also be able to advise on the best way to avoid overwriting existing data, creating new sheets and workbooks, dealing with errors (e.g. exceeding the maximum number of rows in a workbook, which I haven't tried to deal with here). Thanks for posting your solution, Peter Jamieson ------------------------------------------------------------------------- Sub RepeatMailingLabels() ' Using constants makes it easier to modify the sheets you want to use ' But there are other ways to parameterise this, for example using workbook and worksheet names Const sourceSheet = 1 ' the sheet number containing the source data Const targetSheet = 2 ' the sheet number that will contain the label data Const countColumn = 1 ' the column in sourceSheet that contains the label count ' Let's try to declare every variable we use Dim c As Integer Dim r As Long Dim lDestStartRow As Long Dim lDestRow As Long ' Let's put "Excel." in front of Excel objects. That way, we have a much better ' chance of using this code even in Word VBA Dim wsSource As Excel.Worksheet Dim wsTarget As Excel.Worksheet Dim mbrAnswer As VbMsgBoxResult Dim rng2Copy As Excel.Range Set wsSource = Excel.ActiveWorkbook.Sheets(sourceSheet) Set wsTarget = Excel.ActiveWorkbook.Sheets(targetSheet) If ActiveWorkbook.Sheets.Count 2 Then ' Spell it out! The clearer the better. MsgBox "Your Workbook must have at least two Sheets. The first sheet is assumed to be the source of the data, and column one contains the label count. The second sheet will be overwritten by the results.", vbCritical, "Sheet Count" Exit Sub Else mbrAnswer = MsgBox("This macro will delete all information on the second sheet in your workbook: '" & UCase(wsTarget.Name) & "'" & vbCr & vbCr & "Do you want to proceed?", vbQuestion + vbYesNo, "Run Label Maker") If mbrAnswer = vbYes Then ' Clear everything in the target worksheet wsTarget.Cells.Clear Else Exit Sub End If End If ' Copy the first row Set rng2Copy = wsSource.Cells(1, 1).CurrentRegion For c = 1 To rng2Copy.Columns.Count wsTarget.Cells(1, c) = wsSource.Cells(1, c) Next c ' set up the starting row in the target lDestStartRow = 2 ' for each row in the source... For r = 2 To rng2Copy.Rows.Count ....make the number of copies in the target specified in the appropriate column For lDestRow = lDestStartRow To lDestStartRow + wsSource.Cells(r, countColumn) - 1 For c = 1 To rng2Copy.Columns.Count wsTarget.Cells(lDestRow, c) = wsSource.Cells(r, c) Next Next ' remember where to start the next set of copies in the target lDestStartRow = lDestStartRow + wsSource.Cells(r, countColumn) Next ' It's good programming practice to release objects that we ' set up Set wsTarget = Nothing Set wsSource = Nothing End Sub ------------------------------------------------------------------------- "Access101" wrote in message ... I'm still learning VBA in XL, so if someone wants to post a better version of this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
#8
Posted to microsoft.public.word.mailmerge.fields
|
|||
|
|||
Repeating a record
FWIW, this bit...
For lDestRow = lDestStartRow To lDestStartRow + wsSource.Cells(r, countColumn) - 1 For c = 1 To rng2Copy.Columns.Count wsTarget.Cells(lDestRow, c) = wsSource.Cells(r, c) Next Next probably needs to copy only the cell values, leaving formulas behind, e.g. wsTarget.Cells(lDestRow, c).Value = wsSource.Cells(r, c).Value Perhaps needs the formatting as well, and/or to use Value2 to get rid of currency values. On the whole I think it would be advisable to create a new sheet in a new workbook to contain the output, primarily so that the user has the option of using DDE to get the data in tose tricky situations where nothing else works. Peter Jamieson "Peter Jamieson" wrote in message ... Hello Access101, I was also looking at a way to do this fairly easily in Excel, but am also pretty inexperienced in Excel VBA (and rather less experienced than Doug in Word VBA). In fact I would prefer to avoid VBA altogether if possible, and tried to solve this using Jet SQL, which, given a chance and a bit of additional infrastructure, lets you generate the required table using a single SQL statement. But anyway, the thing I was stuck on was the use of "CurrentRegion" to select the necessary block of data, which your code helped me with. But I think yours can be simplified quite a lot, unless there are problems copying source cells to data cells, or other oddities in the Excel object model that I'm not aware of. Here's my current code with some comments that may help you. But I think Doug's suggestion to follow this up in an Excel group is sound - they will know much more about the Excel object model, constant and variable naming conventions, and so on. They may also be able to advise on the best way to avoid overwriting existing data, creating new sheets and workbooks, dealing with errors (e.g. exceeding the maximum number of rows in a workbook, which I haven't tried to deal with here). Thanks for posting your solution, Peter Jamieson ------------------------------------------------------------------------- Sub RepeatMailingLabels() ' Using constants makes it easier to modify the sheets you want to use ' But there are other ways to parameterise this, for example using workbook and worksheet names Const sourceSheet = 1 ' the sheet number containing the source data Const targetSheet = 2 ' the sheet number that will contain the label data Const countColumn = 1 ' the column in sourceSheet that contains the label count ' Let's try to declare every variable we use Dim c As Integer Dim r As Long Dim lDestStartRow As Long Dim lDestRow As Long ' Let's put "Excel." in front of Excel objects. That way, we have a much better ' chance of using this code even in Word VBA Dim wsSource As Excel.Worksheet Dim wsTarget As Excel.Worksheet Dim mbrAnswer As VbMsgBoxResult Dim rng2Copy As Excel.Range Set wsSource = Excel.ActiveWorkbook.Sheets(sourceSheet) Set wsTarget = Excel.ActiveWorkbook.Sheets(targetSheet) If ActiveWorkbook.Sheets.Count 2 Then ' Spell it out! The clearer the better. MsgBox "Your Workbook must have at least two Sheets. The first sheet is assumed to be the source of the data, and column one contains the label count. The second sheet will be overwritten by the results.", vbCritical, "Sheet Count" Exit Sub Else mbrAnswer = MsgBox("This macro will delete all information on the second sheet in your workbook: '" & UCase(wsTarget.Name) & "'" & vbCr & vbCr & "Do you want to proceed?", vbQuestion + vbYesNo, "Run Label Maker") If mbrAnswer = vbYes Then ' Clear everything in the target worksheet wsTarget.Cells.Clear Else Exit Sub End If End If ' Copy the first row Set rng2Copy = wsSource.Cells(1, 1).CurrentRegion For c = 1 To rng2Copy.Columns.Count wsTarget.Cells(1, c) = wsSource.Cells(1, c) Next c ' set up the starting row in the target lDestStartRow = 2 ' for each row in the source... For r = 2 To rng2Copy.Rows.Count ...make the number of copies in the target specified in the appropriate column For lDestRow = lDestStartRow To lDestStartRow + wsSource.Cells(r, countColumn) - 1 For c = 1 To rng2Copy.Columns.Count wsTarget.Cells(lDestRow, c) = wsSource.Cells(r, c) Next Next ' remember where to start the next set of copies in the target lDestStartRow = lDestStartRow + wsSource.Cells(r, countColumn) Next ' It's good programming practice to release objects that we ' set up Set wsTarget = Nothing Set wsSource = Nothing End Sub ------------------------------------------------------------------------- "Access101" wrote in message ... I'm still learning VBA in XL, so if someone wants to post a better version of this back on the site, I'm all for it. This code assumes your Workbook has two Sheets: the Source is the first sheet, and the Destination is the second sheet (though names are not important, just the order within the WB is) The Source sheet can have up to 10 columns (if you use Company Name, ATTN, Country, etc., you might begin to approach 10). Below is an example with just 5 columns with the Count of the Labels in the first column. Lbl-Count Address City State Zip 3 123 Place x y z 1 123 Place x y z 2 123 Place x y z The Lbl-Count column of course, says print the first address 3 times the second address 1 time and the third address 2 times Let me know how it goes. Sub RepeatMailingLabels() Dim wsSRC As Worksheet, wsDEST As Worksheet Dim strItem(10), CurReg As Range Dim colCount As Integer Dim rStart As Integer, lblCount As Integer Set wsSRC = Sheets(1) Set wsDEST = Sheets(2) If ActiveWorkbook.Sheets.Count 2 Then MsgBox "Workbook must have at least two Sheets (a SRC and a DEST), Sheet names are not important.", vbCritical, "Sheet Count" Exit Sub Else answer = MsgBox("This macro will delete all information on Sheet 2 called: " & vbCr & vbCr & Space(5) & "'" & UCase(wsDEST.Name) & "'" & vbCr & vbCr & "Proceed?", vbQuestion + vbYesNo, "Run Label Maker") If answer = vbYes Then wsDEST.Select Cells.Select Selection.ClearContents Range("A1").Select Else Exit Sub End If End If wsSRC.Select wsSRC.Cells(1, 1).Select ActiveCell.CurrentRegion.Select Set CurReg = Selection colCount = CurReg.Columns.Count For cc = 1 To colCount - 1 wsDEST.Cells(1, cc) = wsSRC.Cells(1, cc + 1) Next cc r = 2 While wsSRC.Cells(r, 1) "" wsDEST.Select wsDEST.Cells(r, 1).Select If ActiveCell.Offset(1, 0) = "" Then Else ActiveCell.End(xlDown).Select End If ActiveCell.Offset(1, 0).Select rStart = ActiveCell.Row lblCount = (wsSRC.Cells(r, 1) + rStart) - 1 For c = 2 To colCount strItem(c) = wsSRC.Cells(r, 1).Offset(0, c - 1) Next c For rDEST = rStart To lblCount For c = 2 To colCount wsDEST.Cells(rDEST, 1).Offset(0, c - 2) = strItem(c) Next c Next rDEST r = r + 1 Wend wsDEST.Rows(2).Delete End Sub "Doug Robbins - Word MVP" wrote: You would need to create a data source that contains the necessary number of rows of data for each of the same type of label that you want to produce. While I am sure that can be done with a macro in Excel, being more familiar with macros in Word, I would do it as follows: Copy and paste the Excel Range containing the data into a Word document, and then with that document as the active document, run a macro containing the following code: Dim source As Document, target As Document Dim stable As Table, dtable As Table Dim srow As Row, drow As Row Dim i As Long, j As Long, k As Long, cols As Long Dim numlabels As Range, drange As Range Set source = ActiveDocument Set target = Documents.Add Set stable = source.Tables(1) cols = stable.Columns.Count Set dtable = target.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=cols - 1) For k = 1 To cols - 1 Set drange = stable.Cell(1, k).Range drange.End = drange.End - 1 dtable.Cell(1, k).Range = drange Next k For i = 1 To stable.Rows.Count Set srow = stable.Rows(i) Set numlabels = srow.Cells(cols).Range numlabels.End = numlabels.End - 1 For j = 1 To Val(numlabels.Text) Set drow = dtable.Rows.Add For k = 1 To cols - 1 Set drange = srow.Cells(k).Range drange.End = drange.End - 1 drow.Cells(k).Range = drange Next k Next j Next i The macro assumes that the column containing the number of labels required for each record is the last column of data (re-arrange your Excel spreadsheet if that is not the case) and it creates a new document containing a table that contains the required number of records for each destination that can be used as the data source for merging to produce your labels. -- Hope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP "T. Neil" T. wrote in message ... Hi--I"m trying to print out labels to use on cartons. The data source is an excel spreadsheet. I would like to repeat printing a label (a record) a number of times based on a value in the spreadsheet. For example--in the spreadsheet I have a column with a number--say it's 3. I would like the merge to repeat the same record 3 times before moving on to the next record. I've searched and have come up empty handed. Any help would be greatly appreciated! Thanks, |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Mailmerge: First Record in stead of Next Record | Mailmerge | |||
2 columns; merge so each column has no repeating record | Mailmerge | |||
Record 21 was an empty record | Mailmerge | |||
Mailmerging graphics only works on first record - how can I get Word to print a new graphic for each record? | Mailmerge | |||
How do I stop a field from repeating in next record in mailmerge.. | Mailmerge |