Combine Duplicate times and SUM values v2

[MattLC]

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

 

[joel]

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]

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
















- Show quoted text -

Thanks for the response Joel,

I am still having an issue of it not combining ALL of the intervals, I
think this is due to the way the cells are formatted. Is there a way
to "reset" the cells back to a standard format? (Again Format Cells
doesnt do it). Let me know if you would like a copy of what I am
looking at exactly.

Thanks again.

 

[joel]

The formating will have nothing to do with the issue, the data itself doesn't
match. Usually it is because there are extra spaces in the data or the data
isn't capitlized the same. try this chage

from:
If Range("A" & RowCount) = Range("A" & (RowCount + 1)) Then

to:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
1)))) Then

 

[MattLC]

The formating will have nothing to do with the issue, the data itself doesn't
match.  Usually it is because there are extra spaces in the data or thedata
isn't capitlized the same.  try this chage

from:
If Range("A" & RowCount) = Range("A" & (RowCount + 1)) Then

to:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
1)))) Then








- Show quoted text -

It appears it is some how changed by a forumla I am using. This data
is from three different time zones to begin with, I used a formula to
add the 1 or 2 hours difference I needed. From there I paste special,
keeping only the values. Somehow excel still thinks this data is
different.

 

[joel]

Some of the cells have the date included in the time. Lets try rremoving the
date

from:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
1)))) Then

If Mod(Trim(Range("A" & RowCount)),1) = Mod(Trim(Range("A" & (RowCount +
1))),1) Then

 

[MattLC]

Some of the cells have the date included in the time.  Lets try rremoving the
date

from:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
 1)))) Then

If Mod(Trim(Range("A" & RowCount)),1) = Mod(Trim(Range("A" & (RowCount +
 1))),1) Then






- Show quoted text -

hmm I am getting compile errors using "Mod" for some reason.

 

[joel]

I though of a differnt solution. You also may be having problems if some fof
the number are in a fraction of a minute. I'm going to use the FORMAT
function to extract the just the hours and minutes from the time

from:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
1)))) Then

to:

If format(Range("A" & RowCount),"HH:MM") = _
Format(Range("A" & (RowCount + 1)),"HH:MM") Then

 

[MattLC]

I though of a differnt solution. You also may be having problems if some fof
the number are in a fraction of a minute.  I'm going to use the FORMAT
function to extract the just the hours and minutes from the time

from:
If UCase(Trim(Range("A" & RowCount))) = UCase(Trim(Range("A" & (RowCount +
 1)))) Then

to:

If format(Range("A" & RowCount),"HH:MM") = _
   Format(Range("A" & (RowCount + 1)),"HH:MM") Then






- Show quoted text -

Joel, again I apperciate the Help but I am still getting duplicate
times now. -- Again if you would like to see the workbook itself
please let me know.

IE..


Original:

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



After Macro:

Column A Column B
0:00 1
0:00 3
1:15 1
1:15 1
1:45 1

 

[joel]

The quick way to see the problem is to format Column A to number format and
specify the number of places to 10. then check if the same number is all the
cells. this will show what the real problem is. if you would like to send
me the spreadsheet here is my email

joel dot warburg at itt dot com

 

[MattLC]

The quick way to see the problem is to format Column A to number format and
specify the number of places to 10.  then check if the same number is all the
cells.  this will show what the real problem is.  if you would like to send
me the spreadsheet here is my email

joel dot warburg at itt dot com








- Show quoted text -

Joel I actually did that about 10 minutes before I caught this post =)
That is where the problem is... I have some cells that may show the
time of 22:00 but dec. values are different.