Find dublicates, mark the rows with a color

[Per_]

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Hi,

How can I find dublicates dependent on two columns and mark the rows with a color? Hopefully
anybody could help me!


column1 column2

Smith Jones <-- duplicate pair
Smith Johnson
Smith Jones <-- duplicate pair
Jones Walter



</code>

 

[MrTeeny]

This should highlight duplicates, bit messy looping thru the temporary array as I don't think the worksheet count , match etc functions work with arrays.

Sub loopingTest()    
    Dim ArrayTest() As String
     Dim i As Long, j As Long, count As Long, FinalRow As Long
    ReDim ArrayTest(0)

    FinalRow = Cells(Rows.count, "A").End(xlUp).Row

    For i = 1 To FinalRow
     
            ArrayTest(UBound(ArrayTest)) = Range("A" & i).Value & Range("B" & i).Value
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)


    Next i
    
    For j = 0 To UBound(ArrayTest) - 1
    count = 0
    For i = 1 To FinalRow
        If Range("A" & i).Value & Range("B" & i).Value = ArrayTest(j) Then count = count + 1
    Next i
    If count > 1 Then
    Range("A" & j + 1).EntireRow.Interior.ColorIndex = 20
    Else
    Range("A" & j + 1).EntireRow.Interior.ColorIndex = 0
    End If
    Next j
 
End Sub

 

[Logit]

.
Try this :

Sub ChkColrDupes()
With ActiveSheet
lr = Cells(Rows.count, "A").End(xlUp).Row
For r = 1 To lr
    X3 = Left(Cells(r, "A"), 3)
    X4 = Right(Cells(r, "A"), 4)
    For rr = r + 1 To lr
        If Left(Cells(rr, "A"), 4) = X4 Or Right(Cells(rr, "A"), 3) = X3 Then
            Cells(r, "B") = "<-- Duplicate pair"
            Cells(r, "A").Interior.Color = vbYellow
            Cells(rr, "B") = "<-- Duplicate pair"
            Cells(rr, "A").Interior.Color = vbYellow
        End If


Next rr
Next r


End With
End Sub

 

[FDibbins]

If you need different colors for each pair, this wont work, otherwise you could use Conditional Formatting.

1. highlight the range you want to apply the conditional formatting to
2. on the home tab, styles, select CF
3. select new rule, select use formula
4. enter =countifs($A$1:$A$100,$A1,$b$1:$b$100,$b1)>1 format fill as needed

 

[Per_]

Hi,

Thanks for the answers. I got a very long list of names so it will take very long to loop ... Are there any other way to do it?

 

[FDibbins]

Did you see my suggestion?

 

[Per_]

Hello FDibbins,

I did not understand how to implement it in a vba call ...

 

[FDibbins]

Hello FDibbins,

I did not understand how to implement it in a vba call ...

That was not for VBA, it was using the built-in Conditional Formatting feature

 

[MrTeeny]

Hi,

Thanks for the answers. I got a very long list of names so it will take very long to loop ... Are there any other way to do it?

If you could live with formatting a few cells on each row rather than the whole row you could simply adjust the code I posted to load the range into a temporary array adjust any colours then dump it back to the sheet in one pass, at the moment it's writing to the sheet each time it gets a match because it needs to amend the entire row

Even simple things like Turning off screenupdating and calculations can dramatically speed up code if its continually having to write to the spreadsheet

On Error goto xit:
Application.ScreenUpdating = False
Application.Calculation = xlCalculateManual



'YOUR CODE IN HERE
xit:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic