Some of the students bought 10 passes, others 20, some 30, etc.
I have each student listed once in the database, with a field which contains
the number of passes they bought.
How do I set up a merge with Word so that those who bought 10 passes will
get 10 labels, those who bought 20 will get 20, etc.?
as an example
Dim rng As Range, rng2 As Range
Dim I As Integer, i2 As Integer, i3 As Integer, c As
i3 = 1
Set rng = Application.InputBox(Prompt:="Input Range -
Including the number of passes column", Type:=8)
Set rng2 = Application.InputBox(Prompt:="Number of passes
For I = 1 To rng.Rows.Count
For i2 = 1 To Intersect(rng.Rows(I), rng2).Value
For c = 1 To rng.Columns.Count
Cells(i3, c) = rng.Rows(I).Columns(c)
i3 = i3 + 1
Another possibility by adding another column to you data for how
many passes you want to print for a row. I assume that it would
be Column 2 (Col B), but you will get a choice of changing the
column. You can use the shorter macro to invoke the larger one
with a specific value which is set up for column 4 as an example.
The number you place in col B or other column of your choice
will be changed to a 1 in the original row and it's replications
on the new sheet.
Everything on the new sheet will be left undisturbed except where
you have a number greater than 1 in your selected column.
So if you have an empty cell in your number column, you will
still present one line to mail merge.
Because the cells with a number in the column
Sub repeat_BxN(Optional ColB As Long)
'Repeat row x Col B value 2003-08-22 in misc
Dim wsSource As Worksheet
Dim wsNew As Worksheet
Set wsSource = ActiveSheet
Dim rng As Range, rng2 As Range
Dim vRows As Long, colBstr As String
Dim I As Long
If ColB = 0 Then
On Error Resume Next
ColB = InputBox("Which column has Repetition Count", _
If Err.number <> 0 Then Exit Sub
On Error GoTo 0
Set wsNew = ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set rng = Cells.Columns(ColB) _
Dim A As Long
For A = rng.Areas.Count To 1 Step -1
For I = rng.Areas(A).Count To 1 Step -1
Set rng2 = rng.Areas(A)(I).EntireRow
vRows = rng2.Cells(1, ColB).Value
rng2.Cells(1, ColB).Value = 1
If vRows > 1 Then
Resize(rowsize:=vRows - 1).Insert Shift:=xlDown
rng2.AutoFill rng2.Resize( _
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If not familiar with macros, directions to install and use on my
Getting Started with Macros
Page on printing labels with Mail Merge is mailmerg.htm
With Lance's example, I had a bit of diffulty figuring out what was being
asked for. But you would enter something like
A3:J4 for first question, essentially for rows 3 through 4
B3:B4 for the second question, essentially to indicate the 2nd column,
for the numbers of rows to repeat for the first range.
i.e. A3:J3 repeated B3 times, and
A4:J4 repeated B4 times
Since I can't remember what I entered first, at leat it might be helpful
to show what the first choice was. Kind of redundant I think you just want the rows
for the first and the column for the second. Or maybe I missed something. The
following would at least tell you what you entered for the first part.
Set rng2 = Application.InputBox(Prompt:="Number of passes Range " _
& Chr(10) & "col 2 of " & rng.Address(0, 0), Type:=8)
One additional comment, Mail Merge requires column labels at the
top of the columns for describing the fields used in Mail Merge.
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm
"Lance" <La...@gte.net> wrote in message news:0d7001c368bf$5b14adf0$a401...@phx.gbl...
> You might try using a macro to create a temporary list in
> excel off your current list providing ten listings of the
> student you needs ten, 20, student you needs 20 etc.
> as an example
> Sub newlist()
> Dim rng As Range, rng2 As Range
> Dim I As Integer, i2 As Integer, i3 As Integer, c As
> i3 = 1
> Set rng = Application.InputBox(Prompt:="Input Range -
> Including the number of passes column", Type:=8)
> Set rng2 = Application.InputBox(Prompt:="Number of passes
> Range", Type:=8)
> For I = 1 To rng.Rows.Count
> For i2 = 1 To Intersect(rng.Rows(I), rng2).Value
> For c = 1 To rng.Columns.Count
> Cells(i3, c) = rng.Rows(I).Columns(c)
> Next c
> i3 = i3 + 1
> Next i2
> Next I
> End Sub
> "Glenn" <gl...@glenncoolong.com> wrote ...