Excel VBA-Duplicates run with button/add location

Question

I am new to Excel VBA and I really need your help. I have a code that will look for the duplicate values in Column A. This code will highlight the duplicate values. I want:

1.) This code to ONLY run when I click on a button.

2.) I would like to have (somewhere in the same worksheet), the number of duplicate results and a hyper link that when you click on it will direct you the duplicate result (this is because I have sometimes huge files that I need to validate). Here is the code I currently have:

Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim C As Range, i As Long
If Not Intersect(Target, Me.[A:A]) Is Nothing Then
 Application.EnableEvents = False
 For Each C In Target
   If C.Column = 1 And C.Value > "" Then
      If WorksheetFunction.CountIf(Me.[A:A], C.Value) > 1 Then
         i = C.Interior.ColorIndex
         f = C.Font.ColorIndex
         C.Interior.ColorIndex = 3 ' Red
         C.Font.ColorIndex = 6 ' Yellow
          C.Select
          MsgBox "Duplicate Entry !", vbCritical, "Error"
         C.Interior.ColorIndex = i
         C.Font.ColorIndex = f
      End If
   End If
 Next
 Application.EnableEvents = True
 End If
 End Sub

I would really appreciate it if you help me with this.

Answer 1

Add the code to Module1 Alt+F11

Option Explicit

Sub MyButton()
    Dim RangeCell As Range, _
    MyData As Range
    Dim MyDupList As String
    Dim intMyCounter As Integer
    Dim MyUniqueList As Object
    Dim lngLastRow As Long, lngLoopRow As Long
    Dim lngWriteRow As Long

    Set MyData = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    Set MyUniqueList = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    MyDupList = "": intMyCounter = 0
    '// Find Duplicate
    For Each RangeCell In MyData
        If RangeCell <> "V" And RangeCell <> "R" Then
            If Evaluate("COUNTIF(" & MyData.Address & "," & RangeCell.Address & ")") > 1 Then
                '// Color. Change to suit RGB(141, 180, 226).
                RangeCell.Interior.Color = RGB(141, 255, 226)
                If MyUniqueList.exists(CStr(RangeCell)) = False Then
                    intMyCounter = intMyCounter + 1
                    MyUniqueList.Add CStr(RangeCell), intMyCounter
                    If MyDupList = "" Then
                        MyDupList = RangeCell
                    Else
                        MyDupList = MyDupList & vbNewLine & RangeCell
                    End If
                End If
            Else
                RangeCell.Interior.ColorIndex = xlNone
            End If
        End If
    Next RangeCell
    '// Move duplicate from Column 1 to Column 7 = (G:G)
    lngWriteRow = 1
    lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For lngLoopRow = lngLastRow To 1 Step -1
        With Cells(lngLoopRow, 1)
            If WorksheetFunction.CountIf(Range("A1:A" & lngLastRow), .Value) > 1 Then
                If Range("G:G").Find(.Value, lookat:=xlWhole) Is Nothing Then
                    Cells(lngWriteRow, 7) = .Value
                    lngWriteRow = lngWriteRow + 1
                End If
            End If
        End With
    Next lngLoopRow

    Set MyData = Nothing: Set MyUniqueList = Nothing

    Application.ScreenUpdating = False

    If MyDupList <> "" Then
        MsgBox "Duplicate entries have been found:" & vbNewLine & MyDupList
    Else
        MsgBox "There were no duplicates found in " & MyData.Address
    End If
End Sub

.

Add Module

Add Button

Assign to Macro