CODEWITHSUNDEEP
excelvba
Zubair
Zubair

Reputation: 19

How to find duplicates in a column in excel using vba and then popup a Msgbox?

Want to find duplicates in a column in excel and want to popup a msgbox upon finding even 1 duplicate and it shouldn't keep on popping messages if it finds more than one duplicate.

Also, if i can use two column cell values and use that together to find duplicates, this would be also helpful.

  Sub ColumnDuplicates()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row

    For iCntr = 1 To lastRow
    If Cells(iCntr, 1) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            MsgBox ("There are duplicates in Column A")
        End If
    End If
    Next
    MsgBox ("No Duplicates in Column A")
End Sub

Expecting to print message saying that column A has duplicates or does not have duplicates

Upvotes: 0

Views: 9307

Answers (3)

JvdV
JvdV

Reputation: 75890

What about the use of EVALUATE?

Public Sub Test()

With ThisWorkbook.Sheets("Sheet1")
    lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    If .Evaluate("=Max(countif(A1:A" & lr & ",A1:A" & lr & "))") > 1 Then
        MsgBox "Duplicates!"
    Else
        MsgBox "No Duplicates!"
    End If
End With

End Sub

Or, parameterized:

Public Sub Test(ByVal sheet As Worksheet, ByVal columnHeading As String)

With sheet
    lr = .Cells(.Rows.Count, columnHeading).End(xlUp).Row
    If .Evaluate("=Max(countif(" & columnHeading & "1:" & columnHeading & lr & "," & columnHeading & "1:" & columnHeading & lr & "))") > 1 Then
        MsgBox "Duplicates!"
    Else
        MsgBox "No Duplicates!"
    End If
End With

End Sub

Now you can invoke it like this:

Test Sheet1, "A" ' find dupes in ThisWorkbook/Sheet1 in column A
Test Sheet2, "B" ' find dupes in ThisWorkbook/Sheet2 in column B
Test ActiveWorkbook.Worksheets("SomeSheet"), "Z" ' find dupes in "SomeSheet" worksheet of whatever workbook is currently active, in column Z

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149315

If you have Excel 2007+ then this will be faster. This code ran in 1 sec for 200k rows

Sub Sample()
    Debug.Print Now

    Dim ws As Worksheet
    Dim wsTemp As Worksheet

    Set ws = Sheet1

    Set wsTemp = ThisWorkbook.Sheets.Add

    ws.Columns(1).Copy wsTemp.Columns(1)

    wsTemp.Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo

    If Application.WorksheetFunction.CountA(ws.Columns(1)) <> _
       Application.WorksheetFunction.CountA(wsTemp.Columns(1)) Then
        Debug.Print "There are duplicates in Col A"
    Else
        Debug.Print "duplicates found in Col A"
    End If

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    Debug.Print Now
End Sub

I used the below code to generate 200k records in Col A

Sub GenerateSampleData()
    Range("A1:A200000").Formula = "=Row()"
    Range("A1:A200000").Value = Range("A1:A200000").Value
    Range("A10000:A20000").Value = Range("A20000:A30000").Value
End Sub

Code execution

enter image description here

Upvotes: 2

Tim
Tim

Reputation: 2902

Throw your values in a dictionary

Sub ColumnDuplicates()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

lastRow = Range("A65000").End(xlUp).Row
Set oDictionary = CreateObject("Scripting.Dictionary")
For iCntr = 1 To lastRow
    If Cells(iCntr, 1) <> "" Then
        If oDictionary.Exists(Cells(iCntr, 1).Value) Then
            MsgBox ("There are duplicates in Column A")
            Exit Sub
        Else 
            oDictionary.Add Cells(iCntr, 1).Value, Cells(iCntr, 1).Value
        End If
    End If
Next
MsgBox ("No Duplicates in Column A")
End Sub

Upvotes: 1

Related Questions