Function for detecting duplicates in Excel sheet

Question

Hi Guys,

I need a function that can detect duplicates in a specified Excel column. I have this one but it does not work properly. It cannot distinguish between the value "46.500" and the value "46.5000". The countif function probably compares cells as numbers. These cells are formatted as text and I have even tried to add an apostrophe prior the numbers. No luck.

Function check_duplicates(column As String)
LastRow = Range(column & "65536").End(xlUp).row
For x = LastRow To 1 Step -1

    If Application.WorksheetFunction.CountIf(Range(column & "1:" & column & LastRow), Range(column & x).Text) > 1 Then
        check_duplicates = x  ' return row with a duplicate
        x = 1   
    Else
         check_duplicates = 0
    End If
Next x
End Function

The catch is the line with Countif.

Does anyone know how to force VBA CountIf function to compare cells as strings or other way to check for duplicates in VBA?

Answer 1

The CountIf function doesn't takes a formula as its second argument, so the second argument should be:

"=" & Range(column & x).Text

Answer 2

Assuming all the "text" cells are textual representations of numbers, then the following change will work:

Function check_duplicates(column As String)
    Dim lastrow As Long
    Dim x As Long

    lastrow = Range(column & "65536").End(xlUp).Row
    For x = lastrow To 1 Step -1

        If Application.WorksheetFunction.CountIf(Range(column & "1:" & column & lastrow), Val(Range(column & x).Text)) > 1 Then
            check_duplicates = x  ' return row with a duplicate
            x = 1
        Else
         check_duplicates = 0
        End If
    Next x
End Function

It coerces the value of the criteria cell to a value by the use of the Val function

Answer 3

I usually find ado useful in such circumstances.

Dim cn As Object
Dim rs As Object

strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT F2, Count(F2) AS CountF2 FROM [Sheet1$] " _
  & "GROUP BY F2 HAVING Count(F2)>1 "
rs.Open strSQL, cn

s = rs.GetString
MsgBox s

'' Or
Sheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

Answer 4

Here is new version based on Remou's code. This one is little more versatile and works with MS Excel 2007.

Function check_duplicates(column As Integer)
' checks for duplicates in a column
' usage: column - numerical (A = 1, B=2 etc...)
' returns: "" - no duplicates, otherwise list of duplicates with numbers of occurrences

Dim cn As Object
Dim rs As Object

strFile = ActiveWorkbook.FullName
strSheet = ActiveWorkbook.ActiveSheet.Name

' connection string for Excel 2007
strcon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & _
";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strcon

col = "F" & Trim(Str(column))

strsql = "SELECT " & col & ", Count(" & col & ") AS Count" & col & " FROM [" & strSheet & "$]" & _
"GROUP BY " & col & " HAVING Count(" & col & ")>1 "
rs.Open strsql, cn

If rs.BOF = True And rs.EOF = True Then
        check_duplicates = ""
    Else
        check_duplicates = rs.GetString
End If
End Function

Answer 5

Does this help? http://www.vbaexpress.com/kb/getarticle.php?kb%5Fid=985