ExcelBanter - Systematically Identifying Duplicate Records

Here is some code that finds duplicate records. Higlight the row or column
with teh porention duplicates and run this code. (This code requires a
reference to the Microsoft Scripting Runtime library. In the VB Editor Select
Tools - References - Check Microsoft Scripting Runtime)

Private Sub GetDuplicateItems()
Dim cell As Range 'Current cell in range to check
Dim rngToSearch As Range 'Cells to be searched
Dim dic As Scripting.Dictionary 'Dictionary Object
Dim dicItem As Variant 'Items within dictionary object
Dim wks As Worksheet 'Worksheet to populate with
unique items
Dim rngPaste As Range 'Cells where unique items are
placed
Dim aryDuplicates() As String
Dim lngCounter As Long

Application.ScreenUpdating = False
'Create range to be searched
Set rngToSearch = Intersect(ActiveSheet.UsedRange, Selection)
If rngToSearch Is Nothing Then Set rngToSearch = ActiveCell
lngCounter = 0

'Confirm there is a relevant range selected
If Not rngToSearch Is Nothing Then
'Create dictionay object
Set dic = New Scripting.Dictionary

'Populate dictionary object with unique items (use key to define
unique)
For Each cell In rngToSearch 'Traverse selected range
If Not dic.Exists(cell.Value) And cell.Value < Empty Then
'Check the key
dic.Add cell.Value, cell.Value 'Add the item if unique
Else
ReDim Preserve aryDuplicates(lngCounter)
aryDuplicates(lngCounter) = cell
lngCounter = lngCounter + 1
End If
Next

If lngCounter 0 Then 'Check for values
Set wks = Worksheets.Add 'Create worksheet to populate
Set rngPaste = wks.Range("A1") 'Create range to populate
For lngCounter = LBound(aryDuplicates) To UBound(aryDuplicates)
'Loop duplicates
rngPaste.NumberFormat = "@" 'Format cell as text
rngPaste.Value = aryDuplicates(lngCounter) 'Add items to
new sheet
Set rngPaste = rngPaste.Offset(1, 0) 'Increment paste range
Next lngCounter
'Clean up objects
Set wks = Nothing
Set rngPaste = Nothing
Else
MsgBox "There are no duplicate items in the selected cells.",
vbInformation, "No Duplicates"
End If
Set dic = Nothing
End If
Application.ScreenUpdating = True
End Sub
--
HTH...

Jim Thomlinson

"MWS" wrote:

Can anyone provide code to address the following issue:

Background
Via a control, my program imports records into an excel spreadsheet - cell
A1000 (the imported data actually populates A1000 through I1500). Previously
imported data already occupies cells A1:I100 (Column "I", of both sets of
data, contains a unique record key). The program then continues with
formatting, computing, etc.

Issue
What I need to address is, if any of the new data records match any of the
previously imported data, I want to abort the program (if any record in range
I1:I100 matches any record in I1000:I1500). This will prevent duplicate
records from being systematically input into the file.

Can anyone provide the code to address this situation?

Any and All Help Will Be Appreciated - Thanks In Advance!!!!