Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 486
Default 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!!!!


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Identifying new records Hunginbk Excel Discussion (Misc queries) 2 January 25th 10 09:24 PM
Delete records when certain records have duplicate column data JVroom New Users to Excel 1 January 26th 09 06:23 PM
Identifying duplicate rows TBA Excel Discussion (Misc queries) 2 June 15th 07 09:38 AM
Trouble identifying selected records richardwo Excel Discussion (Misc queries) 4 January 16th 07 01:48 PM
Identifying records with Zero in the data section sumitk Excel Discussion (Misc queries) 2 July 13th 06 11:26 PM


All times are GMT +1. The time now is 09:27 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"