ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Duplicating Rows (https://www.excelbanter.com/excel-programming/325113-duplicating-rows.html)

Jim Berglund

Duplicating Rows
 
I have a set of 1000 rows. The first cell in each row contains 4,6,8,10,or 0.
I need to duplicate each row as many times as the number in the first column.

As validated by the results of the past hour, I don't have a clue how to start.

Please help

Jim

Jim Cone

Duplicating Rows
 
Jim,

While not perfect, the following code is working for me.
Assumes Column A is the column with the numbers.
Please note that you will be using close to the maximum number
of rows in a spread sheet.

'------------------------------------------------------
Sub MakeBigList()
Dim lngNum As Long
Dim lngFirstValue As Long
Dim lngColumnsWide As Long
Dim rngNewRng As Excel.Range
Dim rngCell As Excel.Range
Dim rngList As Excel.Range

Application.ScreenUpdating = False
lngColumnsWide = ActiveSheet.UsedRange.Columns.Count
Set rngList = Range("A1", Cells(Rows.Count, 1).End(xlUp))

For lngNum = rngList.Count To 1 Step -1
Set rngCell = Cells(lngNum, 1)
lngFirstValue = Val(rngCell.Value)
If lngFirstValue 0 Then
Set rngNewRng = rngCell(2, 1).Resize(lngFirstValue, lngColumnsWide)
rngNewRng.Insert shift:=xlShiftDown
Range(rngCell(2, 1), Cells(lngNum + lngFirstValue, _
lngColumnsWide)).Value = rngCell.Resize(1, lngColumnsWide).Value
ActiveSheet.DisplayPageBreaks = False
End If
Next 'lngNum

Application.ScreenUpdating = True
Set rngNewRng = Nothing
Set rngCell = Nothing
Set rngList = Nothing
End Sub
'------------------------------------------

Regards,
Jim Cone
San Francisco, USA



"Jim Berglund" wrote in message
news:ck8Yd.639045$6l.356794@pd7tw2no...
I have a set of 1000 rows. The first cell in each row contains 4,6,8,10,or 0.
I need to duplicate each row as many times as the number in the first column.
As validated by the results of the past hour, I don't have a clue how to start.
Please help
Jim

Jim Berglund

Duplicating Rows
 
Well, I was right - I didn't have a clue as to how to start!

It works!

And there's a lot for me to think through.

Thanks, Jim

Jim Berglund


"Jim Cone" wrote in message
...
Jim,

While not perfect, the following code is working for me.
Assumes Column A is the column with the numbers.
Please note that you will be using close to the maximum number
of rows in a spread sheet.

'------------------------------------------------------
Sub MakeBigList()
Dim lngNum As Long
Dim lngFirstValue As Long
Dim lngColumnsWide As Long
Dim rngNewRng As Excel.Range
Dim rngCell As Excel.Range
Dim rngList As Excel.Range

Application.ScreenUpdating = False
lngColumnsWide = ActiveSheet.UsedRange.Columns.Count
Set rngList = Range("A1", Cells(Rows.Count, 1).End(xlUp))

For lngNum = rngList.Count To 1 Step -1
Set rngCell = Cells(lngNum, 1)
lngFirstValue = Val(rngCell.Value)
If lngFirstValue 0 Then
Set rngNewRng = rngCell(2, 1).Resize(lngFirstValue, lngColumnsWide)
rngNewRng.Insert shift:=xlShiftDown
Range(rngCell(2, 1), Cells(lngNum + lngFirstValue, _
lngColumnsWide)).Value = rngCell.Resize(1,
lngColumnsWide).Value
ActiveSheet.DisplayPageBreaks = False
End If
Next 'lngNum

Application.ScreenUpdating = True
Set rngNewRng = Nothing
Set rngCell = Nothing
Set rngList = Nothing
End Sub
'------------------------------------------

Regards,
Jim Cone
San Francisco, USA



"Jim Berglund" wrote in message
news:ck8Yd.639045$6l.356794@pd7tw2no...
I have a set of 1000 rows. The first cell in each row contains
4,6,8,10,or 0.
I need to duplicate each row as many times as the number in the first
column.
As validated by the results of the past hour, I don't have a clue how to
start.
Please help
Jim





All times are GMT +1. The time now is 08:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com