![]() |
Calculating chnages in time
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 |
Calculating chnages in time
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) "stevie888" wrote in message ... 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 |
All times are GMT +1. The time now is 05:30 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com