Delete duplicate cells
 

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/

Delete duplicate cells
 

I _think_ this does what you want. (if you really have times in those cells!)

It's based on this worksheet formula:
=SUMPRODUCT(--(B1:I1-B1<TIME(0,2,0)))

Say row 1 of your data was in B1:I1. This formula will tell you how many cells
are within 2 minutes of the value in B1. (Try it on a few rows to see if it
gives you the answer you expect--I may have misunderstood your criteria.)

Since it includes itself in that check the value is always 1 or more.

So it's kind of...

if SUMPRODUCT(--(B1:I1-B1<TIME(0,2,0))) 1 then delete that cell.



Option Explicit
Sub testme01()

Dim myRng As Range
Dim myCell As Range
Dim mySubsetRng As Range

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Dim wks As Worksheet
Dim res As Variant

Set wks = Worksheets("sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = FirstRow To LastRow
Set myRng = .Range(.Cells(iRow, "B"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
For Each myCell In myRng.Cells
Set mySubsetRng = .Range(myCell, myRng(myRng.Cells.Count))

'Change this formula to match your worksheet formula.
res = Application.Evaluate("SumProduct(--(" & _
mySubsetRng.Address(external:=True) _
& "-" & myCell.Address(external:=True) _
& "<Time(0, 2, 0)))")

If IsNumeric(res) Then
If res 1 Then
myCell.Delete shift:=xlToLeft
End If
End If
Next myCell
Next iRow
End With
End Sub


======
But you're data doesn't always look like time:
12:02P

I fixed up all the cells that looked like this. I changed 12:02P to 12:02PM.

Then I selected the whole sheet and did two edit|replaces.

edit|replace
what: PM
with: (spacebar)PM
and
edit|replace
what: AM
with: (spacebar)AM

This converted my times to real times and the macro worked ok.

So watch out for the values and watch out for that formula.

"caseyoconnor10 <" wrote:

Could anyone optimize the code I have below. In my worksheet I possibly
could have multiple cells to the right that are duplicates. I need to
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 me
in a specific direction, but the code is not efficient and I have to
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 to
remove cells to the right that are equal or greater than 2 minutes of
the previous cell to the left. It was very interesting taking previous
threads to come up with the code I have below, but its just not quite
cutting it. I was thinking maybe a loop statement or expression such as
IF A1= or <00:02:00 then delete B1. Just to mention every date and time
is in its own cell. The problem with my code is it is not infinite, it
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: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:23AM 9:38AM 11:15AM
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:50PM
2:05PM 3:23PM
06/09/04 6:45AM 6:45AM 6:46AM 9:15AM 9:30AM 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:30PM 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:23AM 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

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

--

Dave Peterson