Create rows by specifying no.

M

Melissa

I have the following data:
Column Value
T2A 7.00
T2A2 8.00

Since value for T2A = 7, I want 7 rows to e created, like this:
T2A 1
T2A 2
T2A 3
T2A 4
T2A 5
T2A 6
T2A 7

and for T2A2:
T2A2 1
T2A2 2
T2A2 3
T2A2 4
T2A2 5
T2A2 6
T2A2 7
T2A2 8

I just wanna enter a value in "Value" and have Excel create the necessary
no. of rows.
 
D

Dave Peterson

Try this against a copy of your workbook--it'll destroy the original data.

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim howMany As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
howMany = .Cells(iRow, "B").Value
If howMany > 1 Then
.Rows(iRow + 1).Resize(howMany - 1).Insert
.Cells(iRow, "A").Resize(howMany).Value _
= .Cells(iRow, "A").Value
With .Cells(iRow, "B").Resize(howMany)
.Formula = "=row()-" & iRow - 1
.Value = .Value
End With
End If
Next iRow
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

And there's no validation against the value in column B. It can blow up really
good if you don't type in nice numbers.
 
M

Melissa

I tested the code on this data:
Adam 5
Brian 4
Carl 3

in worksheet 1, A1:B3.

Then I copied the code as per what you provided into a new macro. The
result I got was:
Adam 5
Brian 1
Brian 2
Brian 3
Brian 4
Carl 1
Carl 2
Carl 3

Brian and Carl are working fine, i.e. 4 rows for B and 3 for C. But Adam
remains as just a single row with the value "5" next to it. What am I doing
wrong?
 
M

Melissa

I realised I should've added in a header row. So that's now solved.
Add-on question: can I target the results to go to another worksheet instead
of overriding my original data?
 
B

Bob Phillips

Change the line that says

FirstRow = 2 'headers in row 1???

to

FirstRow = 1 'headers in row 1???


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
B

Bob Phillips

Sub testme()

Dim wks As Worksheet
Dim wks2 As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim iNext As Long
Dim howMany As Long

Set wks = Worksheets("sheet1")
Set wks2 = Worksheets("sheet2")

wks2.Cells.ClearContents
iNext = 1
With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
howMany = .Cells(iRow, "B").Value
wks2.Cells(iNext, "A").Resize(howMany).Value _
= .Cells(iRow, "A").Value
With wks2.Cells(iNext, "B").Resize(howMany)
.Formula = "=row()-" & iNext - 1
.Value = .Value
End With
iNext = iNext + howMany
Next iRow
End With

End Sub



--

HTH

RP
(remove nothere from the email address if mailing direct)
 
D

Dave Peterson

Easiest thing to do is copy the sheet first.

You can do it manually (just ctrl-click on the worksheet tab and drag it to the
right (or left)).

Or you can do it in code.

Put this after the Dim statements:

Worksheets("sheet1").Copy _
after:=Sheets(Sheets.Count)

Set wks = ActiveSheet

(and remove the "Set wks = Worksheets("sheet1")" line completely.)
 
M

Melissa

Just wanted to share with everybody another code that somebody else provided
me:

Sub ddd()
cntr = 0
For Each ce In Range("a5:a" & Range("a65536").End(xlUp).Row)
For i = 1 To ce.Offset(0, 1)
Sheets("Output").Range("a2").Offset(cntr, 0).Value = ce
Sheets("Output").Range("a2").Offset(cntr, 1).Value = i
cntr = cntr + 1
Next i
Next ce

End Sub
 
Top