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.

xlpart should be xlWHOLE. I tested with a, b, c so it didn't matter but with
your states it may.....
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
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.

Thanks Don,
I only had a moment to test out the code - some things still don't work. I
will continue testing on Monday. I can't send you the file (data privacy
issues) - but I appreciate the offer and the time you've put into this
question. From what I've seen so far, the code is much faster than my
original one...like I said, I'll keep going next week.

Thanks again (I guess the Jims were offended...no more angry venting).

"Don Guillett" wrote:


xlpart should be xlWHOLE. I tested with a, b, c so it didn't matter but with
your states it may.....
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
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.

I only had a moment to test out the code - some things still don't work
Another pet peeve around here is not explaining what "still don't work" may
mean.
Surely the col J is not proprietary. Isn't that the one with the state
codes?
Mine and Jim's both do work on a,b,c,

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"ReportSmith" wrote in message
...
Thanks Don,
I only had a moment to test out the code - some things still don't work.
I
will continue testing on Monday. I can't send you the file (data privacy
issues) - but I appreciate the offer and the time you've put into this
question. From what I've seen so far, the code is much faster than my
original one...like I said, I'll keep going next week.

Thanks again (I guess the Jims were offended...no more angry venting).

"Don Guillett" wrote:


xlpart should be xlWHOLE. I tested with a, b, c so it didn't matter but
with
your states it may.....
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
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.