Results 1 to 6 of 6

Macro to find duplicates across an entire workbook

This is a discussion on Macro to find duplicates across an entire workbook within the Excel Questions forums, part of the Question Forums category; Hi, I have an excel spreadsheet with a few different sheets in it. However, there are some duplicates that need ...

  1. #1
    New Member
    Join Date
    Jun 2004
    Posts
    20

    Default Macro to find duplicates across an entire workbook

    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

  2. #2
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539

    Default Re: Macro to find duplicates across an entire workbook

    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
    JSW: Try and try again: "The way of the Coder!"

  3. #3
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539

    Default Re: Macro to find duplicates across an entire workbook

    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
    JSW: Try and try again: "The way of the Coder!"

  4. #4
    MrExcel MVP Joe Was's Avatar
    Join Date
    Feb 2002
    Location
    Central Florida, USA
    Posts
    7,539

    Default Re: Macro to find duplicates across an entire workbook

    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!
    JSW: Try and try again: "The way of the Coder!"

  5. #5
    Board Regular
    Join Date
    Feb 2003
    Location
    Adelaide, Australia
    Posts
    426

    Default

    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

  6. #6
    Board Regular
    Join Date
    Feb 2003
    Location
    Adelaide, Australia
    Posts
    426

    Default Re: Macro to find duplicates across an entire workbook

    You can grab a copy of my addin, "The Duplicate Master" from http://members.iinet.net.au/~brettdj/

    It will higlight duplicate cells accross the entire workbook with your colour choices

    Cheers

    Dave

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com