Insert row based on months.

[wikus]

Any help will be appreciated.
I want to insert empty rows based on the amount of months between start and end date.
4 empty rows after first date pair.
5 empty rows after second date pair.

 

[Legacy 143009]

Hello,

This should work for you:

Sub test()
  Dim lRow As Long, i As Long, j As Long
  lRow = Cells(Rows.Count, "A").End(xlUp).Row
  With Application
  .ScreenUpdating = False
  For i = lRow To 2 Step -1
    For j = 1 To Evaluate("Mod(" & Month(Cells(i, "B").Value) - Month(Cells(i, "A").Value) & ",12)")
      Rows(i).Offset(1).EntireRow.Insert
    Next
  Next
  .ScreenUpdating = True
  End With
End Sub

 

[rollis13]

See if you can get this macro to work on your project (paste it in a standard or in the sheet's module):

Option Explicit
Sub InsertRows()
    Dim LastRow As Long
    Dim AddToRow As Long
    Dim InsDiff As Integer
    LastRow = Range("A" & Rows.Count).End(xlUp).Row 'calculate last row of column A
    For AddToRow = LastRow To 2 Step -1           'from last to second row
        InsDiff = DateDiff("m", Range("A" & AddToRow), Range("B" & AddToRow)) 'calculate difference by months
        If InsDiff > 1 Then Range("A" & AddToRow + 1 & ":A" & AddToRow + InsDiff).EntireRow.Insert 'insert rows if difference
    Next AddToRow
End Sub

 

[wikus]

See if you can get this macro to work on your project (paste it in a standard or in the sheet's module):

Option Explicit
Sub InsertRows()
    Dim LastRow As Long
    Dim AddToRow As Long
    Dim InsDiff As Integer
    LastRow = Range("A" & Rows.Count).End(xlUp).Row 'calculate last row of column A
    For AddToRow = LastRow To 2 Step -1           'from last to second row
        InsDiff = DateDiff("m", Range("A" & AddToRow), Range("B" & AddToRow)) 'calculate difference by months
        If InsDiff > 1 Then Range("A" & AddToRow + 1 & ":A" & AddToRow + InsDiff).EntireRow.Insert 'insert rows if difference
    Next AddToRow
End Sub

Thank you very much for the reply.

 

[rollis13]

Thanks for the positive feedback, glad we were able to help.

 

[wikus]

Thank you very much for the reply.

Hi Rollis,
I am trying to expand on your code to copy the row into the newly create blank rows but it's not working. May I ask for your assistance?
If I'm not allowed to ask more questions regarding this issue I apologize.
Thank you
Wikus

 

[rollis13]

In truth, it seems to me that it is actually a different request from the title of this thread so in these cases, in order to have even a minimum of visibility in the Forum, I suggest starting a new thread with a new appropriate title.

 

[wikus]

In truth, it seems to me that it is actually a different request from the title of this thread so in these cases, in order to have even a minimum of visibility in the Forum, I suggest starting a new thread with a new appropriate title.

Will do, thank you.