Identify and delete duplicate cells

Won't verify all three variables...only the first

Page 1 of 1

1 Replies - 1351 Views - Last Post: 18 December 2009 - 10:42 AM Rate Topic: -----

#1 guyfromri  Icon User is offline

  • D.I.C Addict

Reputation: 46
  • View blog
  • Posts: 817
  • Joined: 16-September 09

Identify and delete duplicate cells

Posted 17 December 2009 - 04:51 AM

I am trying to find duplicate cells and give some options. I want to do this based on the first 3 columns in each row. This macro works but only by identifying column A. Can someone tell me what I'm doing wrong? I'm sure it's some silly mistake I'm making. Thanks in advance!

Sub DupApptChecker()
	 Dim UGOTDUPS As String									 'DIMENSION
	Cells.Select
	Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
	OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
	DataOption1:=xlSortNormal '////ADD MORE KEYS

	FirstItem = ActiveCell.Value & ActiveCell.Offset(0, 1).Value & ActiveCell.Offset(0, 2).Value
	SecondItem = ActiveCell.Offset(1, 0).Value & ActiveCell.Offset(1, 1).Value & ActiveCell.Offset(1, 2).Value
	Offsetcount = 1

	  Do While ActiveCell <> ""
	  
	  If FirstItem = SecondItem Then
		ActiveCell.Offset(Offsetcount, 0).Interior.Color = RGB(255, 0, 0)
		Offsetcount = Offsetcount + 1
		SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
		dupcount = dupcount + 1
	  Else
		ActiveCell.Offset(Offsetcount, 0).Select
		FirstItem = ActiveCell.Value
		SecondItem = ActiveCell.Offset(1, 0).Value
		Offsetcount = 1
	  End If
Loop
		If dupcount > 0 Then
			UGOTDUPS = MsgBox("You have duplicate appointments in your file! Would you like to delete these based on Fields 1, 2 & 3?" _
					& vbCrLf & vbCrLf & "HIT YES TO DELETE DUPLICATES." _
					& vbCrLf & vbCrLf & "HIT NO TO REMOVE DUPLICATES AND CREATE" _
					& "A NEW REPORT WITH A LIST OF THESE DUPLICATES", vbYesNo + vbCritical, "Look out for dups!")
				If UGOTDUPS = vbYes Then
					call DupDeleter
				elseif UGOTDUPS = vbNo Then
					call DupReport
				End If
				 Else
				MsgBox "No Duplicates Found", vbOK, "No Dups Found"
	   End If
	
End Sub


This post has been edited by guyfromri: 17 December 2009 - 04:53 AM


Is This A Good Question/Topic? 0
  • +

Replies To: Identify and delete duplicate cells

#2 FungalMonkey  Icon User is offline

  • New D.I.C Head

Reputation: 3
  • View blog
  • Posts: 37
  • Joined: 13-December 09

Re: Identify and delete duplicate cells

Posted 18 December 2009 - 10:42 AM

Maybe you need to change the sort range?

Selection.Sort Key1:=Range("A1") ???
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1