Macro Help - Insert row/copy based on criteria

[Katerinia]

I need a macro
that will insert a number of rows
based on the number of months between a start and end date
and then copy the information in the above row to the new rows.

The records are over 8,350.. so ill also need some idea how to get it to
stop when it fills the worksheet so i can transfer those into another workbook

 

[JLGWhiz]

What version of Excel are you using?

 

[JLGWhiz]

If you have xl2007 or later, you probably do not have to worry about the
number of rows, but I included a cut off just in case.

Sub standard()
Dim c As Range, rng As Range, a As Long
Dim sh As Worksheet, lr As Long
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
If Not c Is Nothing Then
a = DateDiff("m", Range("A" & c.Row).Value, Range("B" &
c.Row).Value)
If a > 1 Then
c.Offset(1, 0).Resize(a, 1).EntireRow.Insert
End If
If c.Row >= 65520 Then
MsgBox "Less than 16 rows available, Procedure will
teminate"
Exit Sub
End If
End If
Next
End Sub

 

[JLGWhiz]

P.S.

If your start date is not in column A and your end date is not in column B
then you will need to change the column reference in this line:

Set rng = sh.Range("A2:A" & lr)

And this line:

a = DateDiff("m", Range("A" & c.Row).Value, Range("B" & c.Row).Value)

The code was based on the assumption that col A contains the start Date and
Col B contains the end date. The DateDiff function requires the earlier
date to be the argument before the later date or you will get a negative
result and the code will fail.