How to find duplicates in a column, looping through multiple sheets - vba

Question

I have been trying to write a piece of vba code, so that I can find all of the duplicates in a column, highlight them in red and bring up a message box listing all those duplicated;
and I want the code to do this for column C across multiple sheets. This is essentially to replace conditional formatting, as it was slowing down the workbook about 8 seconds.
This is what I have so far, but it isn't really working.
Sub FindDuplicates()
Sheetcounter = 0
Set MyData = Worksheets("Sheet1").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
Do Until Sheetcounter = 3
Set MyUniqueList = CreateObject("Scripting.Dictionary")
MyUniqueList.RemoveAll
Range(Cells(1, 1), Cells(5000, 1)).Interior.Color = xlNone
Application.ScreenUpdating = False
MyDupList = "": MyCounter = 0
For Each Cell In MyData
If Evaluate("COUNTIF(" & MyData.Address & "," & Cell.Address & ")") > 1 Then
If Cell.Value <> "" Then
Cell.Interior.Color = RGB(255, 80, 80)
If MyUniqueList.exists(CStr(Cell)) = False Then
MyCounter = MyCounter + 1
MyUniqueList.Add CStr(Cell), MyCounter
If MyDupList = "" Then
MyDupList = Cell
Else
MyDupList = MyDupList & vbNewLine & Cell
End If
End If
End If
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
Application.ScreenUpdating = True
If MyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & MyDupList
Else
MsgBox "There were no duplicates found in " & MyData.Address
End If
Sheetcounter = Sheetcounter + 1
If Sheetcounter = 1 Then
Set MyData = Worksheets("Sheet2").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
End If
If Sheetcounter = 2 Then
Set MyData = Worksheets("Sheet3").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
End If
Loop
End Sub

Answer 1

you can simplify your sub like follows:
Option Explicit
Sub FindDuplicates()
Dim sheetCounter As Long
Dim myData As Range, cell As Range
Dim myUniqueList As Scripting.Dictionary
Set myUniqueList = CreateObject("Scripting.Dictionary")
For sheetCounter = 1 To 3
myUniqueList.RemoveAll
With Worksheets("Sheet00" & sheetCounter)
Set myData = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp))
End With
myData.Interior.Color = xlNone
For Each cell In myData.SpecialCells(xlCellTypeConstants)
If WorksheetFunction.CountIf(myData, cell) > 1 Then
cell.Interior.Color = RGB(255, 80, 80)
If Not myUniqueList.Exists(CStr(cell)) Then myUniqueList.Add CStr(cell), myUniqueList.Count + 1
End If
Next cell
If myUniqueList.Count > 0 Then
MsgBox "The following entries have been used more than once:" & vbNewLine & Join(myUniqueList.Keys, vbNewLine)
Else
MsgBox "There were no duplicates found in " & myData.Address
End If
Next sheetCounter
End Sub