Insert a number rows according to a cell value
 

Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's and if the number is
1, eg 4 then insert 3 rows (4-1) and copy the data, so result would
be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
ActiveCell.EntireRow.Select
active.cell.Select
Selection.Insert
GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
Loop

Continue:

Thanks,

Ed

Insert a number rows according to a cell value
 

On Feb 13, 8:05*pm, Ed Peters wrote:
Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's *and if the number is1, eg 4 then insert 3 rows (4-1) and copy the data, so result would

be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
* * ActiveCell.EntireRow.Select
* * active.cell.Select
* * *Selection.Insert
* * *GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
*Loop

Continue:

Thanks,

Ed

Noticied my origial data did not include the one row Londontt,4

so would be

London54 , 1
London44,1
London333,2
Londontt,4
London77,1
London99, 5
London33,1

Ed

Insert a number rows according to a cell value
 

I don't really follow your request but does this do what you want:

Sub Trial()
Dim LastRow As Long
Dim x As Long
Dim I

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1
I = Right(Cells(x, 1).Value, 1)
If IsNumeric(I) Then
If I 1 Then
Cells(x, 1).Resize(I - 1, 1).EntireRow.Insert
End If
End If
Next x

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 2 Step -1
If Cells(x, 1).Value = "" Then _
Cells(x, 1).Value = Cells(x + 1, 1).Value
Next x

Application.ScreenUpdating = True
End Sub

Assumes that the data starts in A1 and has no data under the data given.

Try it on a *COPY* of your data.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk


"Ed Peters" wrote in message
...
On Feb 13, 8:05 pm, Ed Peters wrote:
Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's and if the number is1, eg
4 then insert 3 rows (4-1) and copy the data, so result would

be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
ActiveCell.EntireRow.Select
active.cell.Select
Selection.Insert
GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
Loop

Continue:

Thanks,

Ed

Noticied my origial data did not include the one row Londontt,4

so would be

London54 , 1
London44,1
London333,2
Londontt,4
London77,1
London99, 5
London33,1

Ed

Insert a number rows according to a cell value
 

On Feb 13, 9:09*pm, "Sandy Mann" wrote:
I don't really follow your request but does this do what you want:

Sub Trial()
* * Dim LastRow As Long
* * Dim x As Long
* * Dim I

* * Application.ScreenUpdating = False

* * LastRow = Cells(Rows.Count, 1).End(xlUp).Row

* * For x = LastRow To 1 Step -1
* * * * I = Right(Cells(x, 1).Value, 1)
* * * * If IsNumeric(I) Then
* * * * * * If I 1 Then
* * * * * * * * Cells(x, 1).Resize(I - 1, 1).EntireRow.Insert
* * * * * * End If
* * * * End If
* * Next x

* * LastRow = Cells(Rows.Count, 1).End(xlUp).Row

* * For x = LastRow To 2 Step -1
* * * * If Cells(x, 1).Value = "" Then _
* * * * * * Cells(x, 1).Value = Cells(x + 1, 1).Value
* * Next x

* * Application.ScreenUpdating = True
End Sub

Assumes that the data starts in A1 and has no data under the data given.

Try it on a *COPY* of your data.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk

"Ed Peters" wrote in message

...
On Feb 13, 8:05 pm, Ed Peters wrote:





Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's and if the number is1, eg
4 then insert 3 rows (4-1) and copy the data, so result would

be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
ActiveCell.EntireRow.Select
active.cell.Select
Selection.Insert
GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
Loop

Continue:

Thanks,

Ed

Noticied my origial data did not include the one row Londontt,4

so would be

London54 , 1
London44,1
London333,2
Londontt,4
London77,1
London99, 5
London33,1

Ed- Hide quoted text -

- Show quoted text -

Yes thanks , it got me on the right direction.
Ed

Insert a number rows according to a cell value
 

I'm glad that it helped. Thanks for the feedback.

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk


"Ed Peters" wrote in message
...
On Feb 13, 9:09 pm, "Sandy Mann" wrote:
I don't really follow your request but does this do what you want:

Sub Trial()
Dim LastRow As Long
Dim x As Long
Dim I

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1
I = Right(Cells(x, 1).Value, 1)
If IsNumeric(I) Then
If I 1 Then
Cells(x, 1).Resize(I - 1, 1).EntireRow.Insert
End If
End If
Next x

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 2 Step -1
If Cells(x, 1).Value = "" Then _
Cells(x, 1).Value = Cells(x + 1, 1).Value
Next x

Application.ScreenUpdating = True
End Sub

Assumes that the data starts in A1 and has no data under the data given.

Try it on a *COPY* of your data.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk

"Ed Peters" wrote in message

...
On Feb 13, 8:05 pm, Ed Peters wrote:





Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's and if the number is1,
eg
4 then insert 3 rows (4-1) and copy the data, so result would

be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
ActiveCell.EntireRow.Select
active.cell.Select
Selection.Insert
GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
Loop

Continue:

Thanks,

Ed

Noticied my origial data did not include the one row Londontt,4

so would be

London54 , 1
London44,1
London333,2
Londontt,4
London77,1
London99, 5
London33,1

Ed- Hide quoted text -

- Show quoted text -

Yes thanks , it got me on the right direction.
Ed

Insert a number rows according to a cell value
 

Does this help?
Sub InsertAnyRows()

Dim insertNumber As Range
Dim insertStart As Range
Dim redRng As Range
Dim i As Integer

Set insertNumber = Application.InputBox _
(Prompt:="Select a point to begin inserting rows.
For instance, choose first non blank cell in Column A",
Title:="Add a row", Type:=8)
insertNumber.Select
If insertNumber <= 0 Then
MsgBox ("Invalid Number Entered")
Exit Sub
End If
Dim myRow As Long

lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = 1
Do Until myRow = lastcell
For i = 1 To Cells(myRow, 1)

If Cells(myRow, 1) < "" Then
Cells(myRow + 1, 1).Select
Selection.EntireRow.Insert shift:=xlDown
End If

Next
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = myRow + 1
Loop


End Sub


Regards,
Ryan--

--
RyGuy


"Sandy Mann" wrote:

I'm glad that it helped. Thanks for the feedback.

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk


"Ed Peters" wrote in message
...
On Feb 13, 9:09 pm, "Sandy Mann" wrote:
I don't really follow your request but does this do what you want:

Sub Trial()
Dim LastRow As Long
Dim x As Long
Dim I

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 1 Step -1
I = Right(Cells(x, 1).Value, 1)
If IsNumeric(I) Then
If I 1 Then
Cells(x, 1).Resize(I - 1, 1).EntireRow.Insert
End If
End If
Next x

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 2 Step -1
If Cells(x, 1).Value = "" Then _
Cells(x, 1).Value = Cells(x + 1, 1).Value
Next x

Application.ScreenUpdating = True
End Sub

Assumes that the data starts in A1 and has no data under the data given.

Try it on a *COPY* of your data.

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings


Replace @mailinator.com with @tiscali.co.uk

"Ed Peters" wrote in message

...
On Feb 13, 8:05 pm, Ed Peters wrote:





Hi all,

I am trying to insert and copy a number of rows according to a cell
value.

From the data below I would ignore all the 1's and if the number is1,
eg
4 then insert 3 rows (4-1) and copy the data, so result would

be
Londontt,4
Londontt,4
Londontt,4
Londontt,4

Orginal data below

London54 , 1
London44,1
London333,2
London77,1
London99, 5
London33,1

I can use the code below to loop.

Do Until IsEmpty(ActiveCell) = True

If ActiveCell.Value < 1 Then
ActiveCell.EntireRow.Select
active.cell.Select
Selection.Insert
GoTo Continue
End If

ActiveCell.Offset(1, 0).Select
Loop

Continue:

Thanks,

Ed

Noticied my origial data did not include the one row Londontt,4

so would be

London54 , 1
London44,1
London333,2
Londontt,4
London77,1
London99, 5
London33,1

Ed- Hide quoted text -

- Show quoted text -

Yes thanks , it got me on the right direction.
Ed