sub or function to dedect doubles 1

[matrixknow]

I have a column with employee id's. Sometimes two or more employee ID's are double. I need to dedect if there are ID numbers that appears more then ones. If I found such a number I can copy that to an error sheet.
Has someone an idea for code or is there a build in function to handle this ?

604168
604168
605661
604168
605759

the code should detect :
604168 (appears tree times).

 

[xlbo]

Easiest way to do this is to use COUNTIF and then AUTOFILTER to filter for any result > 1

COUNTIF Formula would be:

=COUNTIF($A$1:$A$1000,A1)

where data is in A1:A1000

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[PWD]

You're probably going to get some messages from the learned members of this forum suggesting that you try to put some code together. I would create some form of loop that started at the first cell, then stored the number and then went down to the bottom of the column, noting any duplications and pasting them in an adjacent column; then move down one row and repeat until the penultimate row. Have a search to see if there's any clues in this forum for "Duplicate Record" or something like that. It's fun getting something like this in place. Best of luck, Des.

 

[matrixknow]

Ok, I have an idea how to loop en further on. I was thinking of a perhaps helpfull function like VLOOKUP. The difference is that I should put all in a module VBA code and not in the excel sheet.

 

[lmbayley]

matrixknow,

If you're looking for a way to detect duplicate entries when they're being entered in the spreadsheet, check out this link:

http://www.cpearson.com/excel/NoDupEntry.htm

As far as I can tell, this method only works if data is being entered by keying it in, as opposed to being dumped to the spreadsheet through a macro. Still, it's nifty.

-LMB

 

[xlbo]

Did you read my post ?

No need to loop

Use VBA to enter the COUNTIF formula:

Range("B2:B1000").formula = "=COUNTIF($B$2:$B$1000,B2)"

(trust me, this will be much much faster than looping)

Copy and paste special values

Filter on the new column for > 1

Copy result set onto new sheet

Remove autofilter

Delete column that had formula in it

et voila

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[matrixknow]

Range("B2:B1000").formula = "=COUNTIF($B$2:$B$1000,B2)"

ok, thanks, I know this is working, I used it before but I don't want to enter this in my worksheet, in fact I am even not allowed to enter this in my worksheet. I just need to dedect a double entry and to copy (not to cut) the value in another worksheet.
VBA recognise a worksheet function COUNTIF and refuse to allowed to use this function ?

 

[xlbo]

So you are "not allowed" to put a formula on the worksheet even if you delete it again afterwards? even if it saves considerable processing time ?

Looping is the most time consuming thing you can do in this situation as you have to compare each row with every other row in the list

The method I have outlined for you is by far the best way of achieving what you want

By way of an example, I knowcked up a 2000 row list with about 20 duplicates in it. Using COUNTIF & Autofilter took ~ 3 seconds. Using a loop - even one that breaks the loop after it finds the 1st dupe for each number, took ~ 47 seconds - over 15 times as long. If you have a long list or more duplicates, the difference will be even greater.

I strongly urge you to think about what the best way to do this is without constraining yourself for no good reason

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[matrixknow]

I underwrite youre idea that looping is time consuming and even more complicated, a COUNTIF is simple.

 

[WinblowsME]

Sub Print_Duplicates()
   Dim duplicates() As String, item As Variant, last_row As Long
   
   last_row = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
      
   Call Get_Duplicates(duplicates, 1, 1, last_row)
   
   For Each item In duplicates
      Debug.Print "Duplicates -> " & item
   Next
End Sub

Private Sub Get_Duplicates(ByRef duplicates() As String, first_row As Long, first_col As Long, last_row As Long)
   Dim i As Long, k As Long, curr_cell As String
   Dim obj_all As Object, obj_duplicates As Object
   
   Set obj_all = CreateObject("Scripting.Dictionary")
   Set obj_duplicates = CreateObject("Scripting.Dictionary")

   k = 0
   
   For i = first_row To last_row
      curr_cell = Trim(Cells(i, first_col))
      
      If obj_all.exists(curr_cell) Then
         If Not obj_duplicates.exists(curr_cell) Then
            ReDim Preserve duplicates(k)
            duplicates(k) = curr_cell
            k = k + 1
            obj_duplicates.Add curr_cell, ""
         End If
      Else
         obj_all.Add curr_cell, ""
      End If
   Next i
   
   obj_duplicates.Removeall
   obj_all.Removeall
   
   Set obj_duplicates = Nothing
   Set obj_all = Nothing
End Sub

 

[AnotherHiggins]

Is your ultimate goal to remove the doubles? Because you can do that without listing the doubles first.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[matrixknow]

To all thanks for your concepts and code. Yesterday I succeeded to use a COUNTIF. Doing this (I am working on an existing application) I got a remark that I was not allowed to modify the structure (by inserting a formula) into the sheet.
After that I tried to reinvent the wheel to write a loop procedure for doubles. Of course this was a time consuming activity.
So now there are a few possibilities.
- I use the formule COUNTIF in a temporary sheet that I afterwards delete. If I found a double I copied this to another sheet.
- Or I use the above code (with little adaptations to fit) in a module.

 

[matrixknow]

WinblowsME (TechnicalUser), this is a fantastic piece of code (sub) and it works from the first time ! I couldn't do it better and it makes my day !

Although I am a programmer, I did not understand all of it.
Its not a demand for an answer but its should be nice to know.
- the argument ByRef duplicates () as string
- the use of objects Set obj_all = CreateObject("Scripting.Dictionary")
- ReDim Preserve duplicates(k)
- the method Get_Duplicates is passing something along the arguments "row", "column", "lastrow" and is returning duplicates in the same time ?

 

[WinblowsME]

- the argument ByRef duplicates () as string
There's ByVal and ByRef. ByVal is the default if it is not listed.
- ByVal (by value) means that the variable, array, or object that's being pass as an argument can't be changed by the sub procedure or function
- ByRef (by reference) means that the variable, array, or object that's being pass as an argument can be changed by the sub procedure or function

- the use of objects Set obj_all = CreateObject("Scripting.Dictionary")
A dictionary object is like a Perl hash.

http://ezinearticles.com/?The-Dictionary-Object....Please-Consider.&id=136536

What's nice about using a dictionary object is that there is an .exists function so that you don't have to loop through the entire data structure to see if a value exists, like one would with an array.

obj_all - Stores all items
obj_duplicates - Stores duplicates

- ReDim Preserve duplicates(k)
This is the dynamic way of increasing your array size. Note that I declared the array without a size.
Dim duplicates() As String

- the method Get_Duplicates is passing something along the arguments "row", "column", "lastrow" and is returning duplicates in the same time ?
row: First row number where data begins
col: Column number where data exists
last_row Last row of data

Maybe a more flexible solution would be

Sub Print_Duplicates()
   Dim duplicates() As String, item As Variant, last_row As Long
   
   last_row = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
   ' [COLOR=red]Data Range:  A1 to Dx[/color]
   Call Get_Duplicates(duplicates, 1, 1, last_row, 4)
   
   For Each item In duplicates
      Debug.Print "Duplicates -> " & item
   Next
End Sub

Private Sub Get_Duplicates(ByRef duplicates() As String, first_row As Long, first_col As Long, _
                                                         last_row As Long, [COLOR=red]last_col As Long[/color])
   Dim i As Long, j As Long, k As Long, curr_cell As String
   Dim obj_all As Object, obj_duplicates As Object
   
   Set obj_all = CreateObject("Scripting.Dictionary")
   Set obj_duplicates = CreateObject("Scripting.Dictionary")

   k = 0
   
   For j = first_col To last_col
      For i = first_row To last_row
         curr_cell = Trim(Cells(i, j))
         
         If curr_cell = "" Then
            Exit For
         End If
         
         If obj_all.exists(curr_cell) Then
            If Not obj_duplicates.exists(curr_cell) Then
               ReDim Preserve duplicates(k)
               duplicates(k) = curr_cell
               k = k + 1
               obj_duplicates.Add curr_cell, ""
            End If
         Else
            obj_all.Add curr_cell, ""
         End If
      Next i
   Next j
   
   obj_duplicates.Removeall
   obj_all.Removeall
   
   Set obj_duplicates = Nothing
   Set obj_all = Nothing
End Sub

 

[matrixknow]

thanks, I may humble consider that there are levels in programmers knowledge. What did you do to reach this level ?

- the method Get_Duplicates is passing something along the arguments "row", "column", "lastrow" and is returning duplicates in the same time ?
row:   First row number where data begins
col:   Column number where data exists
last_row Last row of data

I know but I was confused about the direction of duplicates. Row Colomn LastRow is way down and duplicates is the way up ?

 

[matrixknow]

Public Function check_FUIDd(content As Variant) As Boolean

 If Not IsEmpty(content) Then
  
   Dim duplicates() As String, item As Variant, last_row As Long
   last_row = Sheet1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

   Call Get_DuplicatesChecks(duplicates, 3, 4, last_row)
   
   check_FUIDd = True
   
   For Each item In duplicates
     Debug.Print "Duplicates -> " & item
     check_FUIDd = False
   Next
End If
   
End Function

The method on itself works fine. If I try to include this in a function I got as result all the rows and not only the doubles. I think its a problem between the array and the check_FUIDd(content As Variant). The function is executed for every line.