How to Check for Duplicates and Display a Count MsgBox

dreen

Board Regular
Joined
Nov 20, 2019
Messages
52
I have Three worksheets, and essentially I want to select a cell in Column A of Sheet 2 (As the Active Cell) and check if there are any duplicates in Column A of Sheet 3 (The Range for this Sheet should be from A1 to the last row of Data).
If there are any duplicates, I would like a msgbox to display the number of duplicate values if it's greater than 3.
I have added comments explaining my logic in each step, please feel free to simplify my code as well:

VBA Code:
Sub Check_Duplicates()

    'Declaring variables
    Dim Cell As Variant
    Dim Source As Range
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim rowAC As Long
    Dim Counter As Long

    'Assigning a worksheet to the decalred variables
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set sh3 = Sheet3

    'Sets the Long variable as the Active Cell Row in Sheet 2
    rowAC = ActiveCell.Row

    'Initializing "Source" variable range to last row in Sheet 3
    'Set Source = sh3.Range("A1").End(xlDown)
    Set Source = sh3.Range("A1", sh3.Range("A1").End(xlDown)) 'StackOverFlow Suggestion
    
    'Looping through each cell in the "Source" variable Range
    For Each Cell In Source
    
        'Checking if the "Cell" values in Sheet 3 (in column A to the last row) are equal to the value in the Active Cell in Column A
        If Cell.Value = sh2.Range("A" & rowAC).Value Then
        'If Cell.Value = sh2.Range("MyRange").Value Then
            
            'Checking whether the value in "Cell" already exists in the "Source" range
            If Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then
                
                'Counts and stores the number of duplicate values from Sheet 3 "Cells" compared to the Active Cell value in Sheet 1 Column A
                Counter = Application.WorksheetFunction.CountIf(sh3.Range("Source,Cell"), sh2.Range("A" & rowAC))
                
                'If there are more than 3 duplicates then display a message box
                If Counter > 3 Then
                
                    'Msgbox displaying the number of duplicate values in Sheet 3
                    MsgBox "No. of duplicates is:" & Counter
                
                End If
            
            End If
        
        End If
        
    Next

End Sub

Currently, my code gets to the first IF Statement and simply goes to the End IF, so it doesn't execute past this line and simply goes to Next and then End Sub:

Code:
 If Cell.Value = sh2.Range("A" & rowAC).Value Then

Cross Referencing:

 
Last edited:

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
No need to loop, can just use CountIf against the range,
VBA Code:
Counter = Application.WorksheetFunction.CountIf(Source, sh2.Range("A" & rowAC))
 
Upvote 0
No need to loop, can just use CountIf against the range,
VBA Code:
Counter = Application.WorksheetFunction.CountIf(Source, sh2.Range("A" & rowAC))

Okay I understand that, but I get an error at
VBA Code:
If Cell.Value = sh2.Range("A" & rowAC) Then
because I haven't defined where "Cell" is, how can I do this?
 
Upvote 0
Unless I'm missing something I don't see why you would be using that.
VBA Code:
Sub Check_Duplicates()
    'Declaring variables
    Dim Source As Range
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim rowAC As Long, Counter As Long

    'Assigning a worksheet to the decalred variables
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set sh3 = Sheet3

    'Sets the Long variable as the Active Cell Row in Sheet 2
    rowAC = ActiveCell.Row

    'Initializing "Source" variable range to last row in Sheet 3
    Set Source = sh3.Range("A1", sh3.Range("A" & Rows.Count).End(xlUp))
    
    'count number of times is in Source range
    Counter = Application.WorksheetFunction.CountIf(Source, sh2.Range("A" & rowAC))
    
    'If there are more than 3 duplicates then display a message box
    If Counter > 3 Then
        'Msgbox displaying the number of duplicate values in Sheet 3
        MsgBox "No. of duplicates is: " & Counter
    End If
End Sub
 
Upvote 0
Unless I'm missing something I don't see why you would be using that.
VBA Code:
Sub Check_Duplicates()
    'Declaring variables
    Dim Source As Range
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim rowAC As Long, Counter As Long

    'Assigning a worksheet to the decalred variables
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set sh3 = Sheet3

    'Sets the Long variable as the Active Cell Row in Sheet 2
    rowAC = ActiveCell.Row

    'Initializing "Source" variable range to last row in Sheet 3
    Set Source = sh3.Range("A1", sh3.Range("A" & Rows.Count).End(xlUp))
   
    'count number of times is in Source range
    Counter = Application.WorksheetFunction.CountIf(Source, sh2.Range("A" & rowAC))
   
    'If there are more than 3 duplicates then display a message box
    If Counter > 3 Then
        'Msgbox displaying the number of duplicate values in Sheet 3
        MsgBox "No. of duplicates is: " & Counter
    End If
End Sub

This works well, very elegant solution, thank you for your help! I'm also glad that the loop was eliminated as I found it to serve no function but couldn't quite figure out how to omit it.
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,072
Members
448,546
Latest member
KH Consulting

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