CODEWITHSUNDEEP
vbaexcel
Krishn
Krishn

Reputation: 863

Alternative method for finding duplicates

I have the below code to find duplicate values and this works very well, however my preference is to use the same process without populate cells with the concatenation. Please can someone assist?

Sub Unique_vals()

    Dim rng, lastr, cel As Range, rng1 As Range
    Set lastr = Range("C1048576").End(xlUp).Offset(0, 8)
    Set rng = Range("K12", lastr)
    Set rng1 = Range("K13", lastr)

    If Range("k12").Address = lastr.Address Then 
        Exit Sub

    'populates cells with offset value
    For Each cel In rng

        cel.Value = cel.Offset(0, -8) & cel.Offset(0, -7) & cel.Offset(0, -6) & cel.Offset(0, -5) & cel.Offset(0, -4)

    Next cel

    'from k13 down this check if there is a match above
    For Each cel In rng1

        If Application.WorksheetFunction.CountIf(Range("K12", cel.Offset(-1, 0)), cel) Then 
           cel.Offset(0, 1).Value = "Duplicate"

    Next cel

End Sub

Upvotes: 0

Views: 124

Answers (3)

R.Katnaan
R.Katnaan

Reputation: 2526

I made small modification to your code. If it is not OK, let me know what is wrong. Try this:

Sub Unique_vals()

    Dim lastRange, cell As Range

    Set lastRange = Range("C1048576").End(xlUp).Offset(0, 8)

    If Range("K12").Address = lastRange.Address Then
        Exit Sub
    End If

    'populates cells with offset value
    For Each cell In Range("K12", lastRange)

        cell.Value = cell.Offset(0, -8) & cell.Offset(0, -7) & cell.Offset(0, -6) & cell.Offset(0, -5) & cell.Offset(0, -4)

    Next cell

    'from K13 down this check if there is a match above
    For Each cell In Range("K13", lastRange)

        If Application.WorksheetFunction.CountIf(Range("K12", cell.Offset(-1, 0)), cell) Then

           cell.Offset(0, 1).Value = "Duplicate"

        End If

    Next cell

End Sub

I already tested my code. It work well for me.

Upvotes: 1

mielk
mielk

Reputation: 3940

Dictionary object is the most suitable for this task. Below is the code using object of dictionary type for checking if item already exists.

Sub Unique_vals()
    Const FIRST_ROW As Long = 12
    Dim wks As Excel.Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim rng As Excel.Range
    Dim cell As Excel.Range
    Dim value As String
    '-------------------------------------------------------------------------------


    'Initialize dictionary.
    Set dict = VBA.CreateObject("Scripting.Dictionary")


    Set wks = Excel.ActiveSheet
    With wks
        lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        If lastRow <= FIRST_ROW Then Exit Sub
        Set rng = .Range(.Cells(FIRST_ROW, 11), .Cells(lastRow, 11))   '<--- 11 is index of column K.
    End With



    For Each cell In rng.Cells
        With cell
            value = .Offset(0, -8) & .Offset(0, -7) & .Offset(0, -6) & .Offset(0, -5) & .Offset(0, -4)

            'Check if there is already item with such key in dictionary [dict].
            If dict.exists(value) Then
                'Duplicate
                cell.Offset(0, 1).value = "Duplicate"
            Else
                'Unique value, add it to the dictionary.
                Call dict.Add(value, 0)
            End If

        End With
    Next cell

End Sub

Upvotes: 2

Neha Verma
Neha Verma

Reputation: 21

we can also find values by below statement in excel.

Home-->Conditional Formatting-->Highlights Cell rules-->Duplicate Values

Upvotes: 2

Related Questions