C
caseyoconnor10
Bob,
I worked on the second phase of my problem for a couple weeks, but wa
wondering if you could perfect what I came up with. In my worksheet
possibly could have multiple cells to the right that are duplicates.
need to be able to delete these duplicates and slide all the cells t
the left, which would remove the blank cells. I found some threads tha
lead me in a specific direction, but the code is not efficient and
have to run it multiple times to pick up duplicates that happen mor
than once. Currently the code only picks up duplicates, but I woul
like it to remove cells to the right that are equal or greater than
minutes of the previous cell to the left. It was very interestin
taking previous threads to come up with the code I have below, but it
just not quite cutting it. I was thinking maybe a loop statement o
expression such as IF A1= or <00:02:00 then delete B1. Could you thro
me a bone....once again your intellect is greatly appreciated. Just t
mention every date and time is in its own cell. The problem with m
code is it is not infinite, it only works to column Y. 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:32A
11:15AM 12:01PM 1:49PM 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:23A
9:38AM 11:15AM 12:00PM 1:53PM 2:08PM 3:25PM
06/08/04 6:45AM 9:18AM 9:33AM 10:27AM 10:27A
11:15AM 12:00PM 1:50PM 2:05PM 3:23PM
06/09/04 6:45AM 6:45AM 6:46AM 9:15AM 9:30A
11:20AM 12:05PM 1:55PM 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:30P
2:07PM 2:09PM 2:10PM 2:10PM 2:10PM 2:21PM 3:20PM
06/15/04 6:45AM 7:06AM 7:06AM 8:39AM 8:39AM 9:23A
9:38AM 11:15AM 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
I worked on the second phase of my problem for a couple weeks, but wa
wondering if you could perfect what I came up with. In my worksheet
possibly could have multiple cells to the right that are duplicates.
need to be able to delete these duplicates and slide all the cells t
the left, which would remove the blank cells. I found some threads tha
lead me in a specific direction, but the code is not efficient and
have to run it multiple times to pick up duplicates that happen mor
than once. Currently the code only picks up duplicates, but I woul
like it to remove cells to the right that are equal or greater than
minutes of the previous cell to the left. It was very interestin
taking previous threads to come up with the code I have below, but it
just not quite cutting it. I was thinking maybe a loop statement o
expression such as IF A1= or <00:02:00 then delete B1. Could you thro
me a bone....once again your intellect is greatly appreciated. Just t
mention every date and time is in its own cell. The problem with m
code is it is not infinite, it only works to column Y. 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:32A
11:15AM 12:01PM 1:49PM 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:23A
9:38AM 11:15AM 12:00PM 1:53PM 2:08PM 3:25PM
06/08/04 6:45AM 9:18AM 9:33AM 10:27AM 10:27A
11:15AM 12:00PM 1:50PM 2:05PM 3:23PM
06/09/04 6:45AM 6:45AM 6:46AM 9:15AM 9:30A
11:20AM 12:05PM 1:55PM 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:30P
2:07PM 2:09PM 2:10PM 2:10PM 2:10PM 2:21PM 3:20PM
06/15/04 6:45AM 7:06AM 7:06AM 8:39AM 8:39AM 9:23A
9:38AM 11:15AM 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