Code
-------------------
Sub SortAndInsertSpaces()

Dim iRow As Long
Dim strLast As String

Columns("A:H").Select 'Change this to your columns
Range("A1:H7").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range( _
"F2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom
Range("A1").Select

iRow = 2 'Set to your first row of real data
strLast = Range("B" & iRow)
Do Until Range("B" & iRow).Value = ""
If Range("B" & iRow).Value < strLast Then
Range("B" & iRow).EntireRow.Insert
iRow = iRow + 1
End If
strLast = Range("B" & iRow)
iRow = iRow + 1
Loop

End Su
-------------------

Basically, you sort the data first by name then by date, then inser
the rows. The row insert
code simply counts down column B and inserts a new row when the last
value was different
than the current one. I tested this on a small set of data, so I thin
it will work for you once
you make changes to apply to your worksheet (Sort range and star
row).



--
Message posted from http://www.ExcelForum.com