Excel vba MsgBox to display message when duplicate is found - vba

Question

I am trying to remove duplicates from a table in Excel, I have a piece of code that removes duplicates without any problem, I am wondering if I could make it prompt a message box when a duplicate is found saying something along the lines "This entry is a duplicate entry" Any suggestions? This Is what I got so far:
Sub AccessTransfer()
Range("A1:F1").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 6).Value = "Oven"
Range("A65536").End(xlUp).Offset(1, 0).Select
Call GoDupe
Sheets("Sheet1").Select
Application.CutCopyMode = False
End Sub
Sub GoDupe()
Cells.RemoveDuplicates Columns:=Array(1), Header:=xlNo
Range("A65536").End(xlUp).Offset(1, 0).Select
End Sub

Answer 1

Rather than looping through, identifying and prompting for each duplicate, you could simply highlight all duplicates and prompt the user once.
Your GoDupe() sub could look something like this:
Sub GoDupe()
Cells.FormatConditions.AddUniqueValues
With Cells.FormatConditions(Cells.FormatConditions.Count)
.DupeUnique = xlDuplicate
.Interior.Color = RGB(255, 0, 0)
End With
If MsgBox("Red highlighted cells are duplicated. OK to remove duplicates?", vbOKCancel) = vbOK Then
Cells.RemoveDuplicates Columns:=Array(1), Header:=xlNo
Range("A65536").End(xlUp).Offset(1, 0).Select
End If
Cells.FormatConditions(Cells.FormatConditions.Count).Delete
End Sub