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.