Hey it works! Great, thank you. I may need to do some minor tweaking
because it doesn't seem to grouping properly, but this is exactly what i
needed.
Thanks!
John

"somethinglikeant" wrote:

Sub Macro1()

a = InputBox("Enter Start Date")
a = DateValue(a)

b = InputBox("Enter End Date")
b = DateValue(b)

[F2].Select

Do Until IsEmpty(ActiveCell.Offset(0, -1))
x = DateValue(ActiveCell.Offset(0, -3).Value)
y = DateValue(ActiveCell.Offset(0, -2).Value)

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
y - a

If Application.WorksheetFunction.Max(x, y) _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
b - x

If Application.WorksheetFunction.Max(x, y) < _
Application.WorksheetFunction.Min(a, b) Then ActiveCell.Value =
0

If Application.WorksheetFunction.Min(x, y) _
Application.WorksheetFunction.Max(a, b) Then ActiveCell.Value =
0
ActiveCell.Offset(1, 0).Select
Loop

[A1].Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

[B2].Select

Do Until IsEmpty(ActiveCell)
x = ActiveCell.Value
y = 0
Do Until ActiveCell.Value < x
y = y + ActiveCell.Offset(0, 3).Value
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Insert
ActiveCell.Offset(0, 3).Value = y
ActiveCell.Offset(0, 3).Font.Bold = True
ActiveCell.Offset(1, 0).Select
Loop

End Sub

http://www.excel-ant.co.uk