Re-done using your data. I had a . dot in the wrong place. Just change 10 to
whatever

Sub PlaceBlankRowsBetweenValues()
'Columns("j").SpecialCells(xlCellTypeBlanks).Delet e

lr = Cells(Rows.Count, "j").End(xlUp).Row
Range("J1:J" & lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("AJ1"), Unique:=True

'pick an UNused column
lrc = Cells(Rows.Count, "aj").End(xlUp).Row
mylist = Application.Transpose(Range("aj2:aj" & lrc))
Columns("aj").ClearContents

On Error GoTo nomo
For i = 1 To lrc
p1 = Cells.Find(mylist(i), After:=Range("j1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
'MsgBox p1
p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
'MsgBox p2
dif = Application.CountIf(Columns("j"), mylist(i))
'MsgBox dif
If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert 'Select

Next i
nomo:
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message news:...

Send your workbook to me if you like

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"ReportSmith" wrote in message
...
Don,
It's 6pm here and I finally got a chance to test your code. It is pretty
quick, but it does not take into account a few things, although I did see
how
to get a count of records in the dataset (I can definitely use that).

The code enters lines from row 1 and with each iteration of the For..Next
loop, more lines are added from the top. It does not find the next state
and
do the next 1000th 'ceiling'. Maybe I modified the code wrong.

Also, I found a variable <lrc that wasn't initialized, but used in the
following line(s):
.....
lr = Cells(Rows.Count, "j").End(xlUp).Row
With Range("j1:j" & lr)
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("aj1"),
Unique:=True
End With

'pick an UNused column instead of K
lrk = Cells(Rows.Count, "aj").End(xlUp).Row
mylist = Application.Transpose(Range("aj2:aj" & lrk)) '<-----was <lrc -
mistake?
.....

I used column "AJ" instead of "K" (I have data from col "A" to col "AA")
Like I said, maybe I modified the code incorrectly. Any suggestions?

Thanks again.




"Don Guillett" wrote:

A little cleanup and adapting for you

Sub PlaceBlankRowsBetweenValues()
'Columns("J").SpecialCells(xlCellTypeBlanks).Delet e
lr = Cells(Rows.count, "j").End(xlUp).Row
With Range("j1:j" & lr)
..AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("k1"), Unique:=True
End With

'pick an UNused column instead of K
lrk = Cells(Rows.count, "k").End(xlUp).Row
mylist = Application.Transpose(Range("k2:k" & lrc))
Columns("k").ClearContents

On Error GoTo nomo
For i = 1 To lrk
p1 = Cells.Find(mylist(i), After:=Range("j1"), LookIn:=xlValues,
LookAt:= _
xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
'MsgBox p1
p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues,
LookAt:= _
xlwhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
'MsgBox p2
dif = Application.CountIf(Columns("J"), mylist(i))
'MsgBox dif
If dif < 10 Then Cells(p2, "J").Resize(10 - dif).EntireRow.Insert
'Select

Next i
nomo:
End Sub

"Don Guillett" wrote in message
...
Using FIND should be quicker that each row. Adapt to suit

Sub PlaceBlankRowsBetweenValues()
'Columns(1).SpecialCells(xlCellTypeBlanks).Delete
lr = Cells(Rows.count, "a").End(xlUp).Row
With Range("A1:A" & lr)
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("C1"), Unique:=True
End With

'pick an UNused column
lrc = Cells(Rows.count, "c").End(xlUp).Row
mylist = Application.Transpose(Range("C2:C" & lrc))
Columns("c").ClearContents

On Error GoTo nomo
For i = 1 To lr
p1 = Cells.Find(mylist(i), After:=Range("a1"), LookIn:=xlValues,
LookAt:=
_
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
MsgBox p1
p2 = Cells.Find(mylist(i + 1), After:=Cells(p1, 1), LookIn:=xlValues,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
'MsgBox p2
dif = Application.CountIf(Columns(1), mylist(i))
'MsgBox dif
If dif < 10 Then Cells(p2, 1).Resize(10 - dif).EntireRow.Insert
'Select

Next i
nomo:
End Sub

"ReportSmith" wrote in message
...
A 2-part question. I have code that will sort a a dataset (with
multiple
rows and columns) by the data in column "J" (a STATE field).

Then, the code will cycle through the sorted list and everytime a
state
changes, new lines will be entered to the next 1,000th (so if 'AK'
has
700
rows, 300 blank lines will be entered before the 'AL' rows (which
will
start
on row 1001; if 'AK' has 1100 rows, 900 blank lines willbe entered
before
the
'AL' rows (which will start on row 2001, etc).

The code works, but not as fast as I would like to see. Does anyone
have
any suggestions for a faster way?

Sub Test()
Cells.Select
Selection.Sort Key1:=Range("J2"), Order1:=xlAscending,
Header:=xlYes,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'go to the State column, row 2
Application.Goto reference:="R2C10"
PrevCell = ActiveCell.Value

RowNum = 1
Do Until PrevCell = ""
'find the next state
Do Until ActiveCell.Value < PrevCell
Application.Goto reference:="R" & RowNum + 1 & "C10"
RowNum = RowNum + 1
Loop

'find the next 1000th line
NewRow = Application.WorksheetFunction.Ceiling(RowNum, 1000)
'do until the next 1000th line
Do While RowNum <= NewRow
Rows(RowNum).Select
'select the row
Selection.Insert Shift:=xlDown
'insert blank line
RowNum = RowNum + 1 'go
to
next row
Loop

'move 1 row down and column J
Application.Goto reference:="R" & NewRow + 1 & "C10"
PrevCell = ActiveCell.Value
Loop
End Sub

Thanks in advance for any/all suggestions.