Hello All,
I have a large array of data that I am trying to work with. It is data from a data aquisition system.
Each entry is marked with a date/time stamp. Due to elements beyond my control there are gaps in the data. For example it may jump from:
Nov 28, 2008 06:15:00 to
Nov 31, 2008 15:32:00
Additionaly due to the instruments involved and/or rounding errors sometimes the data gets rounded +/- 1 sec.
e.g.
Nov 31, 2008 15:32:01
I need to match up values and delete the rows where there are no matches. I have the following code which works great until it comes to a second that has been rounded.
Application.ScreenUpdating = False
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
'Matches Dates
Dim i As Integer
For i = 3 To LastRow
If Range("C" & i) <> Range("A" & i) Then
Range("C" & i, "D" & i).Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).Select
Else
End If
Next i
'Deletes Blank Rows
Range(Cells(2, 1), Cells(LastRow, LastColumn)).Select
On Error Resume Next
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
One last thing. If there is a way to do with without a loop it would really speed things up.
I have a large array of data that I am trying to work with. It is data from a data aquisition system.
Each entry is marked with a date/time stamp. Due to elements beyond my control there are gaps in the data. For example it may jump from:
Nov 28, 2008 06:15:00 to
Nov 31, 2008 15:32:00
Additionaly due to the instruments involved and/or rounding errors sometimes the data gets rounded +/- 1 sec.
e.g.
Nov 31, 2008 15:32:01
I need to match up values and delete the rows where there are no matches. I have the following code which works great until it comes to a second that has been rounded.
Application.ScreenUpdating = False
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCell As Range
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
'Matches Dates
Dim i As Integer
For i = 3 To LastRow
If Range("C" & i) <> Range("A" & i) Then
Range("C" & i, "D" & i).Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).Select
Else
End If
Next i
'Deletes Blank Rows
Range(Cells(2, 1), Cells(LastRow, LastColumn)).Select
On Error Resume Next
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
One last thing. If there is a way to do with without a loop it would really speed things up.