Copying rows of data based on a value in a cell.

[Screamerz]

First of all, apologies for using a fake email addy. Just trying to ward off
the spammers...

A little background on what I'm trying to do. Every year, we print out
labels for boxes that are part of a food basket charity that donates boxes
of food and supplies to low-income people so they can have something for
Christmas. The issue is that the customer wants a label for each box, saying
box 1 of 4, box 2 of 4, and so on. In the excel file there is only one line
with the person's name, address and how many boxes the person is to receive.
In order to create a label for each box, I have to insert a blank line for
each box, and then fill down the data from the first line so I have a
duplicate record for each box, then fill in a series to get 1, 2, 3, and so
on. It's a cumbersome process and there are 330 families, for a total of
1770 boxes.

What I am trying to do is to create a macro that when I select a single cell
that is on the row of each family, it would do the process I described
above, by reading the column that contains how many boxes a family is to
receive. I did a macro recording to get an idea. Here's a sample for a
family that is to receive 4 boxes:

Sub OFBSetup()
Rows("1:1").Select
Selection.Insert Shift:=xlUp
Selection.Insert Shift:=xlUp
Selection.Insert Shift:=xlUp
Rows("4:4").Select
Selection.AutoFill Destination:=Rows("1:4"), Type:=xlFillCopy
Rows("1:4").Select
Range("E1").Select
Selection.AutoFill Destination:=Range("E1:E4"), Type:=xlFillSeries
Range("E1:E4").Select
End Sub

I have an idea how to make it work, where I would select the first cell in a
row that I want to expand, then execute the macro-which is to read the value
in column F, which is the number of boxes total, subtract one, then do a
loop where a row would be inserted below the original row, copy the data
from the original row, then increment the value in Column E by 1 in the
newly copied row. The loop will repeat until the value in column E - 1 is
reached.

To clarify, If I select a cell of a row where the value in Column F is "4",
the macro will insert 3 rows, copy down all the values of the entire row
into the blank rows, and do a series fill down into each row of Column E, so
each successive row will read 1, 2, 3, 4.

I hope this helps anyone understand what I want to do. I do have a basic
understanding of programming, but I'm totally new at creating macros for
Excel and am not knowledgeable on the syntax needed to accomplish what I'm
trying to do. I need to have this macro working by Wednesday afternoon since
we have to have the labels printed by Thursday. If I did it manually, it
would have taken me all day to do it, and the macro would be a great
timesaver.

Thanks for your help!!!

 

[Tom Ogilvy]

This should process your whole list. Make a *copy* of that sheet active and
run the code:

Sub Addrows()
Set rng = Cells(Rows.Count, 1).End(xlUp)
For i = rng.Row To 1 Step -1
cnt = Cells(i, "F").Value
If cnt <> 1 Then
Cells(i, 1).EntireRow.Offset(1, 0).Resize(cnt - 1).Insert
Cells(i, 1).EntireRow.Copy Destination:= _
Cells(i, 1).EntireRow.Offset(1, 0).Resize(cnt - 1)
For j = 1 To cnt
Cells(i + j - 1, "E").Value = j
Next
Else
Cells(i, "E") = 1
End If
Next
End Sub

 

[Guest]

Try this:
Sub OFBSetup()
Do Until ActiveCell.Value = ""
LineToInsert = ActiveCell.Offset(0, 5).Value - 1
If LineToInsert = 0 Then
ActiveCell.Offset(1, 0).Select
GoTo BottomOfLoop
Else
End If
ActiveCell.Offset(1, 0).Rows("1:" & (LineToInsert)).EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1:A" & (LineToInsert)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Stop
ActiveCell.Offset(LineToInsert, 0).Select
BottomOfLoop:
Loop
End Sub

File I am working wth has this set up:
ColA ColB ColC ColD ColE Colf
Name Blank Blank Blank Bank 4
Name Blank Blank Blank Bank 3
Name Blank Blank Blank Bank 3
Name Blank Blank Blank Bank 1
Name Blank Blank Blank Bank 2
etc.
***(Start of the first name in A1)***

 

[Screamerz]

I'd like to thank everyone for helping me out on this macro. I used Tom O.'s
version, it worked beautifully, but couldn't exit gracefully. It came up an
error once it hit a row with a blank value in it. I simply hit "End" in the
dialog box.

David's macro did a good job but didn't do the series fill in column E. It
also errored once it hit the end, just like Tom's.

Anyways, thank you for your help, it was a great time saver, and we were
able to finish the job in time.

Barry (Rcoaster)

 

[Tom Ogilvy]

Just for information, the macro expects a number in column F. If the row is
blank, then it doesn't find one. Thus the error.

I expected no blank rows from the last filled row back up to row 1, so I
didn't put in anything to check for this possibility.

But, glad you achieved your objective.