Macro to find duplicates across an entire workbook

brianpunx

New Member
Joined
Jun 24, 2004
Messages
20
Hi,

I have an excel spreadsheet with a few different sheets in it. However, there are some duplicates that need to be identified. Can someone think of a macro that will search for duplicates across the entire workbook and then mark the duplicates (without deleting them)?

Thanks,
Brian
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
This code pevents Duplicate data.

Private Sub Worksheet_Change(ByVal Target As Range)
'Sheet1 code!
'Add to each Sheet's Sheet Module to test!
'Stop Duplicate data.

Dim mySheet As String

If Not Target.Column = 1 Then Exit Sub 'Only work on column A

'Same sheet dup!
If Application.Selection.Value = Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value) Then
mySheet = "This value is already entered on ""Sheet1 Column A!"""
Else
'Other sheet dup.
mySheet = "This value is already entered on ""Sheet2 Column A!"""
End If

If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("A:A"), Target.Value) + Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Target.Value) > 1 Then
MsgBox mySheet
Target.ClearContents
Else
End If

End Sub

Sub flagDup()
'Sheet Module Code!
'Flages every dup on sheet found in Column "A" with
'a message in column "B."
Dim myObject As Range
On Error GoTo myErr

Sheets("Sheet1").Select
Set myCollection = Sheets("Sheet1").Range("A:A")
Sheets("Sheet1").Range("A1").Select
For Each myObject In myCollection
myObject.Select
If Application.WorksheetFunction.CountIf([A:A], myObject) > 1 Then
ActiveCell.Offset(0, 1).Value = "Dup"
Else
ActiveCell.Offset(1, 0).Select
End If
If myObject = "" Then GoTo myEnd
Next myObject
GoTo myEnd

myErr:
MsgBox "Error!"
myEnd:
End Sub
 
Upvote 0
This asks for a value/string to search for and finds all of them on all sheets!
It searches column "A" , you can change this below: Just change the range:

With S.Range("A1:A65536")

This is the range to search on each sheet.
The "Dup" message will be put in Column "B" next to the Dup value, even the first occurance gets a message if it also has a dup. You can chenge the column the "Dup" message gets loged to:

ActiveCell.Offset(0, 1).Value = "Dup"

by changing the columns to move Right of the found value in the offset above in the code below!

Sub myDups()
'Standard Module Code!
'Find All Duplicates on All Sheets!
Dim Message, Title, Default, SearchString

Message = "Enter your search string!" ' Set prompt.
Title = "Find ? On all sheets!" ' Set title.
Default = "" ' Set default.
' Display message, title, and default value.
SearchString = InputBox(Message, Title, Default)
Set S = Sheets.Application
myNext:
For Each S In Application.Sheets
With S.Range("A1:A65536")
Set F = .Find(SearchString, MatchCase:=True, LookAt:=xlWhole, LookIn:=xlValues)
If Not F Is Nothing Then
firstAddress = F.Address
Do
S.Select
F.Select
ActiveCell.Offset(0, 1).Value = "Dup"
F.Value = SearchString
Set F = .FindNext(F)
Loop While Not F Is Nothing And F.Address <> firstAddress
End If
End With
Next S
End Sub
 
Upvote 0
You can check a sheet for duplicates with "Conditional Formatting"

ToolBar: Format - Conditional Formatting...

Select: "Formula Is"

Add:

=If(CountIf(A1:A5000,A1)>1,1,0)

The range can be any range!

Then set the cell color with the format... button.
Select the "Pattern" tab and pick a cell color!
 
Upvote 0
Brian,

I've written a duplicate addin that will highlight, delete or make a summary list of either duplicate cells or duplicate rows accross an entire workbook

PM if you would like to test a beta copy

Regards

Dave
 
Upvote 0
Can we modify this macro to highlight the wanted cells. In addition, i am trying to do this across the workbook for all cells. will this macro still work or can you help me modify this so that i will?
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,974
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top