Loop/copy rows variable times to new sheet

I have a sheet in which every row needs to be copied to a new sheet, but a
variable number of times. Example (source sheet):

Column A Column B
"Two" Pete
"Three" John
"Three" Cindy

I want to look at *text* in column A and say "if A1 is Two then copy this
row to DestinationSheet 2 times, if text is Three copy 3 times." There
will only be 2 or 3 different conditions. When the loop is complete,
DestinationSheet would look like:

Column A Column B
"Two" Pete
"Two" Pete
"Three" John
"Three" John
"Three" John
"Three" Cindy
"Three" Cindy
"Three" Cindy

What is the most efficient way to do this?

Thanks in advance!

Patti

Patti wrote:
> I have a sheet in which every row needs to be copied to a new sheet, but a
> variable number of times. Example (source sheet):
>
> Column A Column B
> "Two" Pete
> "Three" John
> "Three" Cindy
>
> I want to look at *text* in column A and say "if A1 is Two then copy this
> row to DestinationSheet 2 times, if text is Three copy 3 times." There
> will only be 2 or 3 different conditions. When the loop is complete,
> DestinationSheet would look like:
>
> Column A Column B
> "Two" Pete
> "Two" Pete
> "Three" John
> "Three" John
> "Three" John
> "Three" Cindy
> "Three" Cindy
> "Three" Cindy
>
> What is the most efficient way to do this?
>
> Thanks in advance!
>
> Patti

this should work:

dim fr as long, dr as long, numRows as long, i as long
dim from as string, dest as string

from="Sheet1" 'change these to whatever
dest="Sheet2"

fr=1
dr=0

with thisworkbook.sheets(from)
do
select case .cells(fr, 1).value 'column 1 = A
case "Two"
numRows=2
case "Three"
numRows=3
case else
numRows=1
end select
for i=1 to numRows
dr=dr+1
thisworkbook.sheets(dest).cells(dr, 1).value=.cells(fr,1).value
thisworkbook.sheets(dest).cells(dr, 2).value=.cells(fr,2).value
next
fr=fr+1
loop until .cells(fr, 1).value=""
end with


Iain

Try something like this. You will need to modify these two lines

Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

To be the sheet name you are copying from and the sheet name you are copying
to.

Sub test()
Call CopyTextMultipleTimes("Two", 2)
Call CopyTextMultipleTimes("Three", 3)

End Sub

Sub CopyTextMultipleTimes(ByVal TextToFind As String, ByVal Copies As Integer)
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngToSearch As Range Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

Dim rngCopyTo As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim intCounter As Integer

Set rngToSearch = wksCopyFrom.Columns(1)
Set rngCurrent = rngToSearch.Find(TextToFind)
If Not rngCurrent Is Nothing Then
Set rngFirst = rngCurrent
Set rngCopyFrom = rngCurrent.EntireRow
Do
Set rngCopyFrom = Union(rngCurrent.EntireRow, rngCopyFrom)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address

For intCounter = 1 To Copies
Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
rngCopyFrom.Copy rngCopyTo
Next intCounter
End If

End Sub

--
HTH...

Jim Thomlinson


"Patti" wrote:

> I have a sheet in which every row needs to be copied to a new sheet, but a
> variable number of times. Example (source sheet):
>
> Column A Column B
> "Two" Pete
> "Three" John
> "Three" Cindy
>
> I want to look at *text* in column A and say "if A1 is Two then copy this
> row to DestinationSheet 2 times, if text is Three copy 3 times." There
> will only be 2 or 3 different conditions. When the loop is complete,
> DestinationSheet would look like:
>
> Column A Column B
> "Two" Pete
> "Two" Pete
> "Three" John
> "Three" John
> "Three" John
> "Three" Cindy
> "Three" Cindy
> "Three" Cindy
>
> What is the most efficient way to do this?
>
> Thanks in advance!
>
> Patti
>
>
>

Dim rng as Range, cell as Range
Dim kk as Long, i as long
With Worksheets("sheet1")
set rng = .Range(.Cells(2,1),.Cells(2,1).End(xldown))
End with
kk = 2
for each cell in rng
num = 0
Select Case lcase(cell.value)
Case "two"
Num = 2
Case "three"
Num = 3
Case "four"
Num = 4
End Select

for i = 1 to Num
cell.EntireRow.copy Destination:=Worksheets("Sheet2") _
.Cells(kk,1)
kk = kk + 1
next
Next

--
Regards,
Tom Ogilvy

"Patti" <[email protected]> wrote in message
news:[email protected]...
> I have a sheet in which every row needs to be copied to a new sheet, but a
> variable number of times. Example (source sheet):
>
> Column A Column B
> "Two" Pete
> "Three" John
> "Three" Cindy
>
> I want to look at *text* in column A and say "if A1 is Two then copy this
> row to DestinationSheet 2 times, if text is Three copy 3 times." There
> will only be 2 or 3 different conditions. When the loop is complete,
> DestinationSheet would look like:
>
> Column A Column B
> "Two" Pete
> "Two" Pete
> "Three" John
> "Three" John
> "Three" John
> "Three" Cindy
> "Three" Cindy
> "Three" Cindy
>
> What is the most efficient way to do this?
>
> Thanks in advance!
>
> Patti
>
>

<[email protected]> wrote in message
news:[email protected]...
> Patti wrote:
>> I have a sheet in which every row needs to be copied to a new sheet, but
>> a
>> variable number of times. Example (source sheet):
>>
>> Column A Column B
>> "Two" Pete
>> "Three" John
>> "Three" Cindy
>>
>> I want to look at *text* in column A and say "if A1 is Two then copy this
>> row to DestinationSheet 2 times, if text is Three copy 3 times." There
>> will only be 2 or 3 different conditions. When the loop is complete,
>> DestinationSheet would look like:
>>
>> Column A Column B
>> "Two" Pete
>> "Two" Pete
>> "Three" John
>> "Three" John
>> "Three" John
>> "Three" Cindy
>> "Three" Cindy
>> "Three" Cindy
>>
>> What is the most efficient way to do this?
>>
>> Thanks in advance!
>>
>> Patti
>
> this should work:
>
> dim fr as long, dr as long, numRows as long, i as long
> dim from as string, dest as string
>
> from="Sheet1" 'change these to whatever
> dest="Sheet2"
>
> fr=1
> dr=0
>
> with thisworkbook.sheets(from)
> do
> select case .cells(fr, 1).value 'column 1 = A
> case "Two"
> numRows=2
> case "Three"
> numRows=3
> case else
> numRows=1
> end select
> for i=1 to numRows
> dr=dr+1
> thisworkbook.sheets(dest).cells(dr, 1).value=.cells(fr,1).value
> thisworkbook.sheets(dest).cells(dr, 2).value=.cells(fr,2).value
> next
> fr=fr+1
> loop until .cells(fr, 1).value=""
> end with
>
>
> Iain

Iain,

Thanks, this does work beautifully for the example I have given. Since I
actually have many columns of data,I am wondering, though, if there is a way
to copy the whole row at once rather than:

thisworkbook.sheets(dest).cells(dr, 1).value=.cells(fr,1).value
thisworkbook.sheets(dest).cells(dr, 2).value=.cells(fr,2).value

Regards,

Patti

Sorry one of the carriage returns seems to have been deleted when thiss was
posted... And just a note don't try to copy something less than 1 time (which
really only makes sense anyway)

Sub test()
Call CopyTextMultipleTimes("Two", 2)
Call CopyTextMultipleTimes("Three", 3)

End Sub

Sub CopyTextMultipleTimes(ByVal TextToFind As String, ByVal Copies As Integer)
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngCopyFrom As Range
Dim rngToSearch As Range

Set wksCopyFrom = Sheets("Sheet1")
Set wksCopyTo = Sheets("Sheet2")

Dim rngCopyTo As Range
Dim rngCurrent As Range
Dim rngFirst As Range
Dim intCounter As Integer

Set rngToSearch = wksCopyFrom.Columns(1)
Set rngCurrent = rngToSearch.Find(TextToFind)
If Not rngCurrent Is Nothing Then
Set rngFirst = rngCurrent
Set rngCopyFrom = rngCurrent.EntireRow
Do
Set rngCopyFrom = Union(rngCurrent.EntireRow, rngCopyFrom)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address

For intCounter = 1 To Copies
Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
rngCopyFrom.Copy rngCopyTo
Next intCounter
End If

End Sub

--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

> Try something like this. You will need to modify these two lines
>
> Set wksCopyFrom = Sheets("Sheet1")
> Set wksCopyTo = Sheets("Sheet2")
>
> To be the sheet name you are copying from and the sheet name you are copying
> to.
>
> Sub test()
> Call CopyTextMultipleTimes("Two", 2)
> Call CopyTextMultipleTimes("Three", 3)
>
> End Sub
>
> Sub CopyTextMultipleTimes(ByVal TextToFind As String, ByVal Copies As Integer)
> Dim wksCopyFrom As Worksheet
> Dim wksCopyTo As Worksheet
> Dim rngCopyFrom As Range
> Dim rngToSearch As Range Set wksCopyFrom = Sheets("Sheet1")
> Set wksCopyTo = Sheets("Sheet2")
>
> Dim rngCopyTo As Range
> Dim rngCurrent As Range
> Dim rngFirst As Range
> Dim intCounter As Integer
>
> Set rngToSearch = wksCopyFrom.Columns(1)
> Set rngCurrent = rngToSearch.Find(TextToFind)
> If Not rngCurrent Is Nothing Then
> Set rngFirst = rngCurrent
> Set rngCopyFrom = rngCurrent.EntireRow
> Do
> Set rngCopyFrom = Union(rngCurrent.EntireRow, rngCopyFrom)
> Set rngCurrent = rngToSearch.FindNext(rngCurrent)
> Loop Until rngCurrent.Address = rngFirst.Address
>
> For intCounter = 1 To Copies
> Set rngCopyTo = wksCopyTo.Range("A65536").End(xlUp).Offset(1, 0)
> rngCopyFrom.Copy rngCopyTo
> Next intCounter
> End If
>
> End Sub
>
> --
> HTH...
>
> Jim Thomlinson
>
>
> "Patti" wrote:
>
> > I have a sheet in which every row needs to be copied to a new sheet, but a
> > variable number of times. Example (source sheet):
> >
> > Column A Column B
> > "Two" Pete
> > "Three" John
> > "Three" Cindy
> >
> > I want to look at *text* in column A and say "if A1 is Two then copy this
> > row to DestinationSheet 2 times, if text is Three copy 3 times." There
> > will only be 2 or 3 different conditions. When the loop is complete,
> > DestinationSheet would look like:
> >
> > Column A Column B
> > "Two" Pete
> > "Two" Pete
> > "Three" John
> > "Three" John
> > "Three" John
> > "Three" Cindy
> > "Three" Cindy
> > "Three" Cindy
> >
> > What is the most efficient way to do this?
> >
> > Thanks in advance!
> >
> > Patti
> >
> >
> >

Exactly what I need, Tom. Thanks to all of you!

Patti


"Tom Ogilvy" <[email protected]> wrote in message
news:%[email protected]...
> Dim rng as Range, cell as Range
> Dim kk as Long, i as long
> With Worksheets("sheet1")
> set rng = .Range(.Cells(2,1),.Cells(2,1).End(xldown))
> End with
> kk = 2
> for each cell in rng
> num = 0
> Select Case lcase(cell.value)
> Case "two"
> Num = 2
> Case "three"
> Num = 3
> Case "four"
> Num = 4
> End Select
>
> for i = 1 to Num
> cell.EntireRow.copy Destination:=Worksheets("Sheet2") _
> .Cells(kk,1)
> kk = kk + 1
> next
> Next
>
> --
> Regards,
> Tom Ogilvy
>
> "Patti" <[email protected]> wrote in message
> news:[email protected]...
>> I have a sheet in which every row needs to be copied to a new sheet, but
>> a
>> variable number of times. Example (source sheet):
>>
>> Column A Column B
>> "Two" Pete
>> "Three" John
>> "Three" Cindy
>>
>> I want to look at *text* in column A and say "if A1 is Two then copy this
>> row to DestinationSheet 2 times, if text is Three copy 3 times." There
>> will only be 2 or 3 different conditions. When the loop is complete,
>> DestinationSheet would look like:
>>
>> Column A Column B
>> "Two" Pete
>> "Two" Pete
>> "Three" John
>> "Three" John
>> "Three" John
>> "Three" Cindy
>> "Three" Cindy
>> "Three" Cindy
>>
>> What is the most efficient way to do this?
>>
>> Thanks in advance!
>>
>> Patti
>>
>>
>
>

Patti wrote:
> <[email protected]> wrote in message
> news:[email protected]...
> > Patti wrote:
> >> I have a sheet in which every row needs to be copied to a new sheet, but
> >> a
> >> variable number of times. Example (source sheet):
> >>
> >> Column A Column B
> >> "Two" Pete
> >> "Three" John
> >> "Three" Cindy
> >>
> >> I want to look at *text* in column A and say "if A1 is Two then copy this
> >> row to DestinationSheet 2 times, if text is Three copy 3 times." There
> >> will only be 2 or 3 different conditions. When the loop is complete,
> >> DestinationSheet would look like:
> >>
> >> Column A Column B
> >> "Two" Pete
> >> "Two" Pete
> >> "Three" John
> >> "Three" John
> >> "Three" John
> >> "Three" Cindy
> >> "Three" Cindy
> >> "Three" Cindy
> >>
> >> What is the most efficient way to do this?
> >>
> >> Thanks in advance!
> >>
> >> Patti
> >
> > this should work:
> >
> > dim fr as long, dr as long, numRows as long, i as long
> > dim from as string, dest as string
> >
> > from="Sheet1" 'change these to whatever
> > dest="Sheet2"
> >
> > fr=1
> > dr=0
> >
> > with thisworkbook.sheets(from)
> > do
> > select case .cells(fr, 1).value 'column 1 = A
> > case "Two"
> > numRows=2
> > case "Three"
> > numRows=3
> > case else
> > numRows=1
> > end select
> > for i=1 to numRows
> > dr=dr+1
> > thisworkbook.sheets(dest).cells(dr, 1).value=.cells(fr,1).value
> > thisworkbook.sheets(dest).cells(dr, 2).value=.cells(fr,2).value
> > next
> > fr=fr+1
> > loop until .cells(fr, 1).value=""
> > end with
> >
> >
> > Iain
>
> Iain,
>
> Thanks, this does work beautifully for the example I have given. Since I
> actually have many columns of data,I am wondering, though, if there is a way
> to copy the whole row at once rather than:
>
> thisworkbook.sheets(dest).cells(dr, 1).value=.cells(fr,1).value
> thisworkbook.sheets(dest).cells(dr, 2).value=.cells(fr,2).value
>
> Regards,
>
> Patti

..cells(fr,1).entirerow.copy
..cells(dr,1).paste

though it might be better to use pastespecial, pasting only values

Iain

>cells(fr,1).entirerow.copy
>.cells(dr,1).paste

>though it might be better to use pastespecial, pasting only values

>Iain

Of course, line 2 should be:

thisworkbook.sheets(dest).cells(dr,1).paste

Iain