Insert a number of rows based on a value in a cell on active row

[iRocco]

Insert a number of rows based on a value in a cell on active row

--------------------------------------------------------------------------------

Hey all. I am new to macros in excel. Hoping to find help. I have
worksheet, 3 columns and lets say 1000 rows. Column A is a beginnin
page number of a document, column B is its ending page number, an
column C is the number of pages calculated by subtracting Bx - Ay an
adding 1. Example:

...
1000 1001 1
1002 1005 4
1006 1007 2
1008 1008 1
...

I'd like to have a macro which would go line-by-line and insert a
appropriate number of rows in between so I can flesh-out the ranges o
values. Example result would be:

1000 1001 1

1002 1005 4



1006 1007 2

1008 1008 1


Any help would be greatly appreciated

 

[Guest]

1iRocco,

Assuming your data example has an unintended error, I believe this does what
you want. I used your corrected data in cells A1:C4 for my test. (I believe
you intended 1000 1001 to be 2 pages, not 1. I ran this off of a command
button and it seems to work. As long as your data is consistent(col C should
be a formula, not manual entry), there shouldn't be a problem. The process is
set up to scan from the bottom up, since we will be inserting rows, it's
easier to keep track of things that way. It will scan all the way up to row
1, unless you alter the setting where I have commented. Put it in the click
event of a comand button and give it a shot. Naturally, back up your workbook
first.

Roy

Dim LastRow As Double, RowsToInsert As Integer, x As Integer
Dim CalculationMode As Long
Dim OriginalPageBreakMode As Boolean

With Application
CalculationMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
OriginalPageBreakMode = .DisplayPageBreaks
.DisplayPageBreaks = False
End With

LastRow = Sheet1.Range("a65536").End(xlUp).Row 'find last occupied row.
Do Until LastRow = 1 ' IMPORTANT > set this value equal to your top data row.
RowsToInsert = Cells(LastRow - 1, 3).Value - 1
Rows(LastRow).Select
If RowsToInsert > 0 Then
For x = 1 To RowsToInsert
Rows(LastRow).Insert
Next
End If
LastRow = LastRow - 1
Loop
Range("A1").Activate
With Application
.Calculation = CalculationMode
.ScreenUpdating = True
End With

ActiveSheet.DisplayPageBreaks = OriginalPageBreakMode