Thanks for letting us know and you're welcome.

Try this adaptation where the code holds the current calculation method, switches it to manual and then resets it to its original setting after the macro has run:

VBA Code:

```
Option Explicit
Sub Macro2()
Dim ws As Worksheet
Dim lngLastRow As Long
Dim lngMyRow As Long
Dim i As Long
Dim xlnCalcMethod As XlCalculation
With Application
.ScreenUpdating = False
xlnCalcMethod = .Calculation
.Calculation = xlCalculationManual
End With
Set ws = ThisWorkbook.Sheets("Card Collection") 'Sheet containing the data. Change to suit if necessary.
lngLastRow = ws.Range("A:Z").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For lngMyRow = lngLastRow To 2 Step -1
If IsNumeric(ws.Range("B" & lngMyRow)) = True And ws.Range("B" & lngMyRow) > 1 Then
For i = 1 To ws.Range("B" & lngMyRow) - 1
ws.Rows(lngMyRow).Insert
ws.Rows(lngMyRow + 1).Copy Destination:=ws.Rows(lngMyRow)
Next i
End If
Next lngMyRow
With Application
.Calculation = xlnCalcMethod
.ScreenUpdating = True
End With
End Sub
```

Regards,

Robert

Robert,

I didn't want to create a new post since my question is so similar to Seba's. I have a similar issue, and have been tweaking the code you wrote to help with that. This is the worksheet.

Column A is on the left there, and column B on the right. I want to add a new row for each value in column B (dates repeat) that is equal to 09/30/2010, and then inside the new empty cell in column B to insert a value equal to the next quarter. In this case it would be 12/31/2010.

Here's the code I have so far:

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

Option Explicit

Sub Macro1()

Dim ws As Worksheet

Dim lngLastRow As Long

Dim lngMyRow As Long

Dim i As Long

Dim pastQuarter As Date

pastQuarter = DateValue("September 30, 2010")

Dim currentQuarter As Date

currentQuarter = DateValue("December 31, 2010")

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Sheets("DateLU") 'Sheet containing the data. Change to suit if necessary.

lngLastRow = ws.Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For lngMyRow = lngLastRow To 2 Step 1

If IsNumeric(ws.Range("B" & lngMyRow)) = True And ws.Range("B" & lngMyRow).Value = pastQuarter Then

For i = 1 To ws.Range("B" & lngMyRow) + 1

ws.Rows(lngMyRow).Insert

ws.Rows(lngMyRow + 1).Value = currentQuarter

Next i

End If

Next lngMyRow

Application.ScreenUpdating = True

End Sub

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

Any suggestions on how to make this work?

Thank you so much in advance.