User written VBA code to test for duplicate values produces unexpected output

[ExcelRogue]

I wrote a function to return True if a cell range contains duplicate values.

Function Range_Contains_Duplicate_Values(Rng As Range) As Boolean
'-------------------------------------------------------------------------------
' NAME
'   Range_Contains_Duplicate_Values(Rng As Range) As Boolean
'
' DESCRIPTION
'   Returns True if any value in the 1-column-wide cell range "Rng" occurs more
'   than once.
'
' PARAMETERS
'   Name: Rng
'   Type: Range
'   Description: The cell range to be checked for duplicate values. Should only
'                be 1 column wide.
'
' RETURNS
'   Type: Boolean
'-------------------------------------------------------------------------------
    Dim i As Long
    Dim j As Long
    Dim Strt_Row As Long
    Dim Stop_Row As Long
    Dim Comp_Cell As Range
    Dim Orig_Cell As Range
    
    Strt_Row = Rng.Row
    Stop_Row = Rng.Rows.Count + Strt_Row - 1
    
    If Rng.Columns.Count <> 1 Then
        MsgBox "Rng must be 1 column wide."
        End
    End If
    For i = Strt_Row To Stop_Row - 1
        Set Orig_Cell = Rng.Cells(i, 1)
        For j = i + 1 To Stop_Row
            Set Comp_Cell = Rng.Cells(j, 1)
            If Orig_Cell.Value = Comp_Cell.Value Then
                Range_Contains_Duplicate_Values = True
                Exit Function
            End If
        Next j
    Next i
    Range_Contains_Duplicate_Values = False
End Function

I test this function on the Active Worksheet using this procedure.

Sub Test_Duplicate_Method_On_ActiveSheet()
'-------------------------------------------------------------------------------
' NAME
'   Test_Duplicate_Method_On_ActiveSheet()
'
' DESCRIPTION
'   Tests the "Range_Contains_Duplicate_Values(Rng As Range) As Boolean"
'   procedure on the ActiveSheet on 10 Range objects, 500 cells each.
'
' PARAMETER
'   Nothing
'
' RETURNS
'   Nothing
'-------------------------------------------------------------------------------
    Const LIMIT As Long = 5000
    
    Dim Result As Boolean
    Dim Coll As Collection
    Dim i As Long
    Dim Addr As String
    
    Set Coll = New Collection
    
    ActiveSheet.Cells.Delete
    For i = 1 To LIMIT
        ActiveSheet.Cells(i, 1).Value = i
    Next i
    Coll.Add Item:=ActiveSheet.Range("A1:A500")
    Coll.Add Item:=ActiveSheet.Range("A501:A1000")
    Coll.Add Item:=ActiveSheet.Range("A1001:A1500")
    Coll.Add Item:=ActiveSheet.Range("A1501:A2000")
    Coll.Add Item:=ActiveSheet.Range("A2001:A2500")
    Coll.Add Item:=ActiveSheet.Range("A2501:A3000")
    Coll.Add Item:=ActiveSheet.Range("A3001:A3500")
    Coll.Add Item:=ActiveSheet.Range("A3501:A4000")
    Coll.Add Item:=ActiveSheet.Range("A4001:A4500")
    Coll.Add Item:=ActiveSheet.Range("A4501:A5000")
    For i = 1 To Coll.Count
        Addr = Coll(i).Address(False, False)
        Result = Range_Contains_Duplicate_Values(Coll(i))
        Debug.Print Addr & " has duplicate values? " & Result
    Next i
End Sub

Inexplicably, my Debug.Print output is the following.

A1:A500 has duplicate values? False
A501:A1000 has duplicate values? False
A1001:A1500 has duplicate values? False
A1501:A2000 has duplicate values? False
A2001:A2500 has duplicate values? False
A2501:A3000 has duplicate values? True
A3001:A3500 has duplicate values? True
A3501:A4000 has duplicate values? True
A4001:A4500 has duplicate values? True
A4501:A5000 has duplicate values? True

Can someone please explain this behavior? Warning: If you run this code, it deletes all cells on your ActiveSheet. I am using Excel 2013 in Windows 7.

Thanks,
ExcelRogue

 

[Fluff]

Your function should be

    [COLOR=#ff0000]For i = 1 To Rng.Count - 1[/COLOR]
        Set Orig_Cell = Rng.Cells(i, 1)
        [COLOR=#ff0000]For j = i + 1 To Rng.Count[/COLOR]
            Set Comp_Cell = Rng.Cells(j, 1)
            If Orig_Cell.Value = Comp_Cell.Value Then
                Range_Contains_Duplicate_Values = True
                Exit Function
            End If
        Next j
    Next i

If you add this line to your function as it stands, you should see the problem

            If Orig_Cell.Value = Comp_Cell.Value Then
              [COLOR=#0000ff] Debug.Print Rng.Cells(i, 1).Address[/COLOR]
                Range_Contains_Duplicate_Values = True
                Exit Function
            End If

 

[Fluff]

You could also right the function like

    Dim i As Long
    
    With CreateObject("scripting.dictionary")
      For i = 1 To Rng.Count
         If Not .Exists(Rng(i).Value) Then
            .Add Rng(i).Value, Nothing
         Else
            Range_Contains_Duplicate_Values = True
            Exit Function
         End If
      Next i
   End With

which should be quicker.

 

[ExcelRogue]

Thank you Fluff! This was exactly my problem.

Best,
ExcelRogue

Your function should be

    [COLOR=#ff0000]For i = 1 To Rng.Count - 1[/COLOR]
        Set Orig_Cell = Rng.Cells(i, 1)
        [COLOR=#ff0000]For j = i + 1 To Rng.Count[/COLOR]
            Set Comp_Cell = Rng.Cells(j, 1)
            If Orig_Cell.Value = Comp_Cell.Value Then
                Range_Contains_Duplicate_Values = True
                Exit Function
            End If
        Next j
    Next i

If you add this line to your function as it stands, you should see the problem

            If Orig_Cell.Value = Comp_Cell.Value Then
              [COLOR=#0000ff] Debug.Print Rng.Cells(i, 1).Address[/COLOR]
                Range_Contains_Duplicate_Values = True
                Exit Function
            End If

 

[AlphaFrog]

Your function is intermixing absolute and relative row numbers.

    For i = Strt_Row To Stop_Row - 1
        Set Orig_Cell = Rng.Cells(i, 1)
        For j = i + 1 To Stop_Row
            Set Comp_Cell = Rng.Cells(j, 1)

Strt_Row and Stop_Row are absolute row numbers; the top and bottom rows of rng.

Rng.Cells(i,1) and Rng.Cells(j,1) use relative row numbers.
Rng.Cells(1,1) would be the first cell in Rng regardless of what row Rng starts at.

I think you want something like...

For i = 1 to Rng.Rows.count - 1

For j = i + 1 to Rng.Rows.Count

 

[ExcelRogue]

Yes, you are absolutely correct. I'm a little embarrassed I didn't catch that but go figure; I knew I was my own worst enemy.

Thanks,
ExcelRogue

Your function is intermixing absolute and relative row numbers.

    For i = Strt_Row To Stop_Row - 1
        Set Orig_Cell = Rng.Cells(i, 1)
        For j = i + 1 To Stop_Row
            Set Comp_Cell = Rng.Cells(j, 1)

Strt_Row and Stop_Row are absolute row numbers; the top and bottom rows of rng.

Rng.Cells(i,1) and Rng.Cells(j,1) use relative row numbers.
Rng.Cells(1,1) would be the first cell in Rng regardless of what row Rng starts at.

I think you want something like...

For i = 1 to Rng.Rows.count - 1

For j = i + 1 to Rng.Rows.Count

 

[ExcelRogue]

Yes, this version is much faster. Why?

Thanks,
ExcelRogue

You could also right the function like

    Dim i As Long
    
    With CreateObject("scripting.dictionary")
      For i = 1 To Rng.Count
         If Not .Exists(Rng(i).Value) Then
            .Add Rng(i).Value, Nothing
         Else
            Range_Contains_Duplicate_Values = True
            Exit Function
         End If
      Next i
   End With

which should be quicker.

 

[Fluff]

Checking if a value exists in a Dictionary is a lot faster than using nested loops.
They are well worth learning.