Macro for inserting a row for every change in a record

Posted by John S. on April 05, 2001 6:44 AM

1 column of data. The 1st 10 rows are "dog". The next 6 are "cat". This goes on for over 100 different animals ranging from 1 row to 20. I need to insert a row after each change in animal with a macro. thanks

Posted by Barrie Davidson on April 05, 2001 8:05 AM

Try this (it assumes that your data is in column A).

Sub Insert_row()
Dim Number_of_rows

Number_of_rows = ActiveSheet.UsedRange.Rows.Count
Range("A2").Select
Do Until Selection.Row = Number_of_rows + 1
If Selection.Value &LT;&GT; Selection.Offset(-1, 0).Value Then
Selection.EntireRow.Insert
Number_of_rows = Number_of_rows + 1
Selection.Offset(2, 0).Select
Else
Selection.Offset(1, 0).Select
End If
Loop

End Sub

Posted by David Hawley on April 05, 2001 6:30 PM

Hi Barry

As I don't generally use Loops due their slow running, you can do this (Insert rows) with in one step:

Sub Placeinrows()
Dim ListRange As Range

Set ListRange = Range("A2:A1000")
ListRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Set ListRange = _
ListRange.SpecialCells(xlCellTypeVisible)

ActiveSheet.ShowAllData
ListRange.EntireRow.Insert

Set ListRange = Nothing
End Sub
OzGrid Business Applications

Posted by Sylvester on April 06, 2001 5:53 AM

Dave
Avoiding loops is a good practice, but does your macro work if an animal name appears only once?
For example : Dog,Dog,Dog,Cat,Mouse,Cow,Horse,Horse.
Sylvester

Posted by Barrie Davidson on April 06, 2001 7:04 AM

Thanks for the tip Dave.

Posted by Dave Hawley on April 06, 2001 4:45 PM

Dave Avoiding loops is a good practice, but does your macro work if an animal name appears only once? For example : Dog,Dog,Dog,Cat,Mouse,Cow,Horse,Horse. Sylvester

Now Sylvester you know the answer don't you :o) ?

You are dead right though ! I should not have made the assumption there were no singles.

If this is the case I would use the dreaded loop BUT! Not on all entries, I would first narrow down the range to loop through to only the cells where the animal changes. Like below:

Sub Placeinrows()
Dim ListRange As Range
Dim i As Integer, Rw As Integer
Application.ScreenUpdating = False

Set ListRange = Range("A2:A10000")

ListRange.Offset(0, 1) = _
"=IF(RC[-1]&LT;&GT;R[-1]C[-1],NA(),"""")"

Set ListRange = _
ListRange.Offset(0, 1).SpecialCells(xlCellTypeFormulas, xlErrors)

For i = ListRange.Areas.Count To 1 Step -1
For Rw = ListRange.Areas(i).Rows.Count To 1 Step -1
ListRange.Areas(i).Rows(Rw).EntireRow.Insert (xlShiftDown)
Next Rw
Next i

Columns(2).Clear
Application.ScreenUpdating = True

Set ListRange = Nothing
End Sub

What do you think ?

Dave

OzGrid Business Applications