VBA find duplicates in column and list row number?

Question

I am using the following VBA code to search a column for duplicate values. If found then i want to populate cell Q1 with a hyperlink to that row number.

Here's what i have:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 15 And Len(Target.Value) > 0 Then             
        If Evaluate("Countif(O:O," & Target.Address & ")") > 1 Then
            Range("P1").Value = "DUPLICATE ENTRY EXISTS"            
            Range("Q1").Formula= "=HYPERLINK()"                     
        End If             
    End If

End Sub

Please can someone show me how to get the row number of the duplicate value?

Answer 1

I would just use the Range.Find method to accomplish both checking for duplicates and getting the Address. You may want to consider clearing the hyperlink and the cell at some point in time. You could check to see if there are any duplicates, and clear if that is the case; or you could check for multiple duplicates, and output them in sequential cells. All kinds of things.

EDIT You also need to decide how to handle the situation in which Target is a multicell range. Consider the situation where Target is entirely within Column O, and where it is not.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range, C As Range
    Dim S As String

Set R = Columns(15)

If Not Intersect(Target, R) Is Nothing Then
    Application.EnableEvents = False
    Set C = R.Find(what:=Target.Text, after:=Target, LookIn:=xlValues, _
        lookat:=xlWhole, MatchCase:=False)
    If C.Address <> Target.Address Then
        S = C.Address(external:=True)
        S = Mid(S, InStr(S, "]") + 1)
        Range("q1").Hyperlinks.Delete
        Range("Q1").Hyperlinks.Add Anchor:=Range("q1"), _
            Address:="", SubAddress:=S, _
            TextToDisplay:=C.Address, ScreenTip:="Duplicate Entry"

    Else 'Clear Q1 if no duplicate
        Range("Q1").Clear
    End If
End If
Application.EnableEvents = True

End Sub

Answer 2

Try the code below, it's not as simple as I would like it to be, but it works.

Once you find that the current value entered in column "O" has a duplicate, I am using the Find method to find the next match.

Code

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Target.Column = 15 And Len(Target.Value) > 0 Then

        If Evaluate("Countif(O:O," & Target.Address & ")") > 1 Then
            Range("P1").Value = "DUPLICATE ENTRY EXISTS"

            Dim RowDup As Long
            Dim FindRng As Range
            Dim LastRow As Long

            LastRow = Cells(Rows.Count, Target.Column).End(xlUp).Row ' get last row with data in Column "O"

            If Target.Row = 1 Then
                Set FindRng = Range(Cells(Target.Row + 1, Target.Column), Cells(LastRow, Target.Column))
            Else ' define a search range, substract target cell from active range in column "O"
                Set FindRng = Application.Union(Range(Cells(1, Target.Column), Cells(Target.Row - 1, Target.Column)), Range(Cells(Target.Row + 1, Target.Column), Cells(LastRow, Target.Column)))
            End If

            ' find thr row number in the column O (except Target cell)
            RowDup = FindRng.Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

            ' get the hyperlink to the cell where the first dupliacte exists
            Range("Q1").Formula = "=HYPERLINK(" & Range(Cells(RowDup, Target.Column), Cells(RowDup, Target.Column)).Address & ")"
        End If
    End If
    Application.EnableEvents = True

End Sub