[guyfromri]

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

[FungalMonkey]

Maybe you need to change the sort range?

Selection.Sort Key1:=Range("A1") ???