Bernie, I also tried your coded, because it was so much faster, I also could
not get it to do what the OP wanted, it adds row but puts the data where it
inserted the rows at the bottom of the data. As lost says "seems to jumble
everything up"

"Bernie Deitrick" wrote in message
...
Dear Lost,

Is your data range contiguous, or does it already have blank rows in it?
Do
you have blank columns - or hidden blank columns? Do you have cells
beneath
your data range that have values? Try selecting cell R1 and then use Edit
Go To... Special, Current Region and see what area is selected.

The code worked perfectly with my test spreadsheet - if you can't figure
it
out based on my guesses above, then email the workbook to me and I'll see
what I can see.

HTH,
Bernie
MS Excel MVP

"Lost" wrote in message
...
Thanks, but I can't get it to work...I need to insert
entire rows in between dates...

Your code seems to jumble everything up? What am I doing
wrong? My dates are in column R, so I exchanged your 2 for
my column 18...any clues?

-----Original Message-----
Dear Lost,

The code below will insert two blank rows at every change
in value in
column B. To use a different column, change the myCol =
2 to an
appropriate number.

This also assumes you have headers in Row 1.

This code uses the fastest way to insert rows: sorting
using Excel's
built-in sorting routines. Other code is possible that
would step
cell-wise through your range of data, but inserting
mulitple pairs of
rows can be quite slow on large files.

HTH,
Bernie
MS Excel MVP

Sub Insert2BlankColumns()
Dim myCell1 As Range
Dim myCell2 As Range
Dim myCol As Integer
Dim myRow As Long

'Change these two variables as needed
myCol = 2 'For column B
myRow = 1 'Row with labels

Set myCell1 = Cells(Rows.Count, myCol).End(xlUp)
Range(Cells(myRow, myCol), myCell1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=myCell1(2), _
Unique:=True
myCell1(2).EntireRow.Delete
Set myCell2 = Cells(Rows.Count, myCol).End(xlUp)
Range(myCell1(2), myCell2).Copy myCell2(2)

Cells(myRow, myCol).CurrentRegion.Sort _
Key1:=Cells(myRow, myCol), _
Order1:=xlAscending, _
Header:=xlYes

For Each myCell1 In Range(Cells(myRow, myCol), _
Cells(Rows.Count, myCol).End(xlUp))
If myCell1(1, 0).Value = "" Then myCell1.ClearContents
Next myCell1
End Sub
"Lost" wrote in
message
...
I hope someone can help me with this confusing thing.

I have a large spreadsheet (20,000 rows +) and I have a
date in column R. The sheet has been sorted on column R.

I want the most efficient code I can find to insert two
rows everytime the a different date is found in column
R.

Please supply your example code...and thanks millions...




.