find and count duplicates

This is the Excel VBA tip that helps you to highlight the duplicate values in a column. This code also tells you the number of duplicates in every group. Every group contains unique items. There are two procedures in this program. The first procedure--HighlightDuplicates highlights the duplicate items found in the input column. It also displays the number of duplicates in the third column. Two loops are needed to find the duplicates. The outer loop is used to move to the next row while the inner loop compares the data in the current row with all the rest rows. The number of duplicates increases by one if the comparison results true. The number of duplicates displays after the inner loop finishes. The additional procedure is called ShowMaxOnly. It is called to pick the biggest number of duplicates in each group of items found.

Each procedure has two arguments. The first argument is the ranged of cells that contains the data to find the duplicates. Another argument specifies the column that the number of duplicates in each group will display.

The example code below assumes that the range of cells that contains the duplicates is B1:B15. You can change this value to what you want by changing the value of the rng variable. The range must be a range of cells in one column only. If you want to change the column to display the number of duplicates, you need to change the value of the col variable.

To run this example code, you will follow the steps below:

-Make sure the column, B contains data that you want to find duplicates

-Press Alt+F11 to show the VBA code editor

-Double-click the sheet that you want to apply the code

-From the (General) drow down list, select Worksheet and from the (Declarations) drop download list, select Activate

-Press Ctrl+A and then press Ctrl+V

Note: This code works when the sheet activates.

Option Explicit
Private Sub Worksheet_Activate()
   Dim col As Integer
   Dim rng As String
   col = 3
   rng = "B1:B15"
   HighLightDuplicates rng, col
   ShowMaxOnly rng, col

End Sub

Sub HighLightDuplicates(ByVal rng As String, ByVal col As Integer)
Dim i, j As Integer
Dim temp As Variant
Range(rng).Select
Dim Count As Integer
Count = 1

     For i = 1 To Selection.Count
       temp = Range(Left(rng, 1) & i)
       For j = i + 1 To Selection.Count
         If temp = Range(Left(rng, 1) & j) And temp <> "" Then
             Count = Count + 1 'increase the number of duplicates
             'highlight the duplicates
             Range(Left(rng, 1) & i).Interior.Color = RGB(0, 100, 255)
             Range(Left(rng, 1) & j).Interior.Color = RGB(0, 100, 255)
            
         End If
        
        
         Next
     'show the number of duplicates
     If Count > 1 Then
        Cells(i, col) = Count & " duplicates"
     End If
     'reset count
     Count = 1
    
    Next
End Sub
'show only the biggest number of duplcates in a group

Sub ShowMaxOnly(ByVal rng As String, ByVal col As Integer)
Dim i, j As Integer
Dim temp As Variant
Range(rng).Select

i = 1
     For i = 1 To Selection.Count
       temp = Range(Left(rng, 1) & i)
       For j = i + 1 To Selection.Count
         If temp = Range(Left(rng, 1) & j) And temp <> "" Then
            
             Cells(j, col) = "" 'remove the smaller numbers duplicates
         End If
        
         Next
    Next
End Sub

Posted by: Dara | post date: 10-04-2013 | Subject: VBA for MS Excel




This website intents to provide free and high quality tutorials, examples, exercises and solutions, questions and answers of programming and scripting languages:
C, C++, C#, Java, VB.NET, Python, VBA,PHP & Mysql, SQL, JSP, ASP.NET,HTML, CSS, JQuery, JavaScript and other applications such as MS Excel, MS Access, and MS Word. However, we don't guarantee all things of the web are accurate. If you find any error, please report it then we will take actions to correct it as soon as possible.