Try this code it is much simplier. From what I can tell of you code your
offsets were wrong. You had column offsets instead of row offsets in some
cases.

Sub TimeX()

Dim TimeInv
Dim cnt As Long
Dim total As Long


'sort the data
Range("A1").Activate
ActiveCell.CurrentRegion.Sort _
Key1:=ActiveCell, _
Order1:=xlAscending, _
Header:=xlYes, _
DataOption1:=xlSortTextAsNumbers

'Start at the second row - assumes will always be the first time interval
Range("A1").Activate
TimeInv = ActiveCell.Value 'get the first range in the sheet;
'assumes info starts at A1

RowCount = 2
Start = RowCount
Do While Range("A" & RowCount) < ""
If Range("A" & RowCount) = Range("A" & (RowCount + 1)) Then
Range("A" & RowCount) = _
Range("A" & RowCount) + Range("A" & (RowCount + 1))
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop

End Sub



"MattLC" wrote:

All,


It may be easier to provide an example oppose to trying to explain
this issue.


Currently I have hundereds of rows that look like this.
Column A Column B
1:00 1
1:15 1
1:15 2
1:15 2
1:45 0
2:00 0
2:00 0


The End Result should look like this;

Column A Column B
1:00 1
1:15 5
1:45 0
2:00 0


Here is the macro I currently have and for some reason its not
combining ALL of the times.. just most. I can send the attachment if
needed, here is the current macro. It may be a formatting issue with
the cells, therefore my second question is -- Is there an easy way to
make all cells in a column be the same format? (Right Click-- Format
Cells doesnt do the trick).


Sub TimeX()

Dim TimeInv
Dim cnt As Long
Dim total As Long


'sort the data
Range("A1").Activate
ActiveCell.CurrentRegion.Sort Key1:=ActiveCell, Order1:=xlAscending,
Header:=xlYes, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers

'Start at the second row - assumes will always be the first time
interval
Range("A1").Activate
TimeInv = ActiveCell.Value 'get the first range in the sheet;
assumes info starts at A1

While ActiveCell < "" 'while the current cell is not blank -
pAUSesses until it hits a blank cell

If ActiveCell.Value < TimeInv Then
ActiveCell.EntireRow.Insert 'insert a row and write out
values
ActiveCell.Value = TimeInv
ActiveCell.Offset(0, 1).Activate
ActiveCell.Offset.Value = total
total = 0 'reset total
cnt = 0 'reset cnt
ActiveCell.Offset(1, -1).Select 'go to the next row
TimeInv = ActiveCell.Value
Else
'capture count in varibles, then delete the row
cnt = ActiveCell.Offset(0, 1).Value
total = cnt + total
ActiveCell.EntireRow.Delete
End If

Wend

End Sub