Could anyone optimize the code I have below. In my worksheet I possibl
could have multiple cells to the right that are duplicates. I need t
be able to delete these duplicates and slide all the cells to the left
which would remove the blank cells. I found some threads that lead m
in a specific direction, but the code is not efficient and I have t
run it multiple times to pick up duplicates that happen more than once
Currently the code only picks up duplicates, but I would like it t
remove cells to the right that are equal or greater than 2 minutes o
the previous cell to the left. It was very interesting taking previou
threads to come up with the code I have below, but its just not quit
cutting it. I was thinking maybe a loop statement or expression such a
IF A1= or <00:02:00 then delete B1. Just to mention every date and tim
is in its own cell. The problem with my code is it is not infinite, i
only works to column Y. Anyones help would be greatly appreciated
Thanks again!

Here is the raw data:

06/02/04 6:45AM 9:20AM 9:35AM 11:15AM 12:02P 1:50PM 2:05PM 3:15PM
06/03/04 6:46AM 8:06AM 8:06AM 9:17AM 9:32AM 11:15AM 12:01PM 1:49P
2:04PM 3:18PM
06/04/04 6:45AM 9:15AM 9:30AM 11:00AM
06/07/04 6:45AM 8:33AM 8:33AM 8:33AM 8:33AM 9:23AM 9:38AM 11:15A
12:00PM 1:53PM 2:08PM 3:25PM
06/08/04 6:45AM 9:18AM 9:33AM 10:27AM 10:27AM 11:15AM 12:00PM 1:50P
2:05PM 3:23PM
06/09/04 6:45AM 6:45AM 6:46AM 9:15AM 9:30AM 11:20AM 12:05PM 1:55P
2:10PM 2:33PM 2:33PM 3:15PM
06/10/04 6:45AM 9:23AM 9:38AM 11:19AM 12:04PM 2:02PM 2:16PM 3:15PM
06/11/04 6:45AM 9:24AM 9:39AM 12:01PM
06/14/04 6:45AM 9:24AM 9:39AM 11:46AM 12:30PM 2:07PM 2:09PM 2:10P
2:10PM 2:10PM 2:21PM 3:20PM
06/15/04 6:45AM 7:06AM 7:06AM 8:39AM 8:39AM 9:23AM 9:38AM 11:15A
12:00PM 1:46PM 2:01PM 3:32PM
06/16/04 6:45AM 9:32AM 9:52AM 11:15AM 12:00PM 1:50PM 2:27PM 3:29PM
06/17/04 6:45AM 9:30AM 9:45AM 11:37AM 12:21PM 1:47PM 2:02PM 3:15PM
06/18/04 6:45AM 9:15AM 9:30AM 11:15AM 12:00PM 2:02PM 2:17PM 3:24PM
06/21/04 6:45AM 9:20AM 9:35AM 11:27AM 12:12PM 1:48PM 2:03PM 3:16PM
06/22/04 6:45AM 9:19AM 9:34AM 11:22AM 12:11PM 1:50PM 2:05PM 3:24PM

Here is the current code I am using:

Application.ScreenUpdating = False

For x = 1 To 250

If Range("B" & x & "") = Range("C" & x & "") Then
Range("B" & x & "") = Delete
End If
If Range("C" & x & "") = Range("D" & x & "") Then
Range("C" & x & "") = Delete
End If
If Range("D" & x & "") = Range("E" & x & "") Then
Range("D" & x & "") = Delete
End If
If Range("E" & x & "") = Range("F" & x & "") Then
Range("E" & x & "") = Delete
End If
If Range("F" & x & "") = Range("G" & x & "") Then
Range("F" & x & "") = Delete
End If
If Range("G" & x & "") = Range("H" & x & "") Then
Range("G" & x & "") = Delete
End If
If Range("H" & x & "") = Range("I" & x & "") Then
Range("H" & x & "") = Delete
End If
If Range("I" & x & "") = Range("J" & x & "") Then
Range("I" & x & "") = Delete
End If
If Range("J" & i & "") = Range("K" & i & "") Then
Range("J" & i & "") = Delete
End If
If Range("K" & i & "") = Range("L" & i & "") Then
Range("K" & i & "") = Delete
End If
If Range("L" & i & "") = Range("M" & i & "") Then
Range("L" & i & "") = Delete
End If
If Range("M" & i & "") = Range("N" & i & "") Then
Range("M" & i & "") = Delete
End If
If Range("N" & i & "") = Range("O" & i & "") Then
Range("N" & i & "") = Delete
End If
If Range("O" & i & "") = Range("P" & i & "") Then
Range("O" & i & "") = Delete
End If
If Range("P" & i & "") = Range("Q" & i & "") Then
Range("P" & i & "") = Delete
End If
If Range("Q" & i & "") = Range("R" & i & "") Then
Range("Q" & i & "") = Delete
End If
If Range("R" & i & "") = Range("S" & i & "") Then
Range("R" & i & "") = Delete
End If
If Range("S" & i & "") = Range("T" & i & "") Then
Range("S" & i & "") = Delete
End If
If Range("T" & i & "") = Range("U" & i & "") Then
Range("T" & i & "") = Delete
End If
If Range("U" & i & "") = Range("V" & i & "") Then
Range("U" & i & "") = Delete
End If
If Range("V" & i & "") = Range("W" & i & "") Then
Range("V" & i & "") = Delete
End If
If Range("W" & i & "") = Range("X" & i & "") Then
Range("W" & i & "") = Delete
End If
If Range("X" & i & "") = Range("Y" & i & "") Then
Range("X" & i & "") = Delete
End If
If Range("Y" & i & "") = Range("Z" & i & "") Then
Range("Y" & i & "") = Delete
End If

Next

'Deletes blank cells and shifts all to the left

Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlToLeft

Application.ScreenUpdating = True


End Sub


---
Message posted from http://www.ExcelForum.com/