Calculating chnages in time

S

stevie888

Basically, they log the time and date that a website was 'hit'. The report
requires a great deal of formatting before any sense can be made of it. The
following is the format of the data.

Date Time
01-Sep-06 12:46:50
01-Sep-06 12:46:51
01-Sep-06 12:46:52
01-Sep-06 12:46:52
01-Sep-06 12:46:52
01-Sep-06 12:46:52
01-Sep-06 15:01:47
01-Sep-06 15:01:47
01-Sep-06 15:01:48
01-Sep-06 15:01:48
01-Sep-06 15:02:01
01-Sep-06 15:02:47
01-Sep-06 15:02:47
01-Sep-06 15:02:47

What i am wanting to do (or hope one of you can help me in doing it ) is
create a macro that compares each row as it goes down, deleting any rows
where the time difference is <= 00:03:00 from the last row, or inserting an
empty row where the difference > 00:03:00.

So the above data would be formatted to

01-Sep-06 12:46:50
01-Sep-06 12:46:52

01-Sep-06 15:01:47
01-Sep-06 15:02:47

In addition, if the date changes, I need a blank row inserting. Any help
would be very much appreciated.
this is what i have up to now

the code works by calculating a number taken from multiplying the time
column by 1 to get a decimal number

Sub Final2()
Dim Date1 As Double
Dim Date2 As Double
Dim Date3 As Double
Dim x As Integer

Application.Goto Range("C2")
x = 0
Do Until IsEmpty(ActiveCell.Offset(1, 0).Value)
Date1 = ActiveCell.Value
Date2 = ActiveCell.Offset(1, 0)
Date3 = ActiveCell.Offset(-1, 0)

If Date1 - Date3 < 0.002083333 And Date1 - Date2 < 0.002083333 Then
ActiveCell.Offset(1, 0).EntireRow.Delete
x = x + 1
Else
If Date2 - Date3 < 0 Then
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert
End If
ActiveCell.Offset(1, 0).Select
End If
Loop
MsgBox x & " Rows were deleted", vbInformation + vbOKOnly, "Information"
End Sub
 
B

Bob Phillips

Public Sub PreocessData()
Dim iLastRow As Long
Dim i As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow - 1 To 2 Step -1
If Cells(i + 1, "B").Value - Cells(i, "B").Value > TimeSerial(0,
3, 0) Then
Rows(i + 1).Insert
ElseIf Cells(i + 1, "B").Value - Cells(i, "B").Value <
TimeSerial(0, 3, 0) Then
Rows(i).Delete
End If
Next i

End With

End Sub


--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top