Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Identifying new records | Excel Discussion (Misc queries) | |||
Delete records when certain records have duplicate column data | New Users to Excel | |||
Identifying duplicate rows | Excel Discussion (Misc queries) | |||
Trouble identifying selected records | Excel Discussion (Misc queries) | |||
Identifying records with Zero in the data section | Excel Discussion (Misc queries) |