Formula / Macro to find Duplicate Row based on multiple Columns conditions

[Arafat]

Hi All,

What would be the best way to find the duplicates using values from multiple columns.

Example : Concatenate value of columns A & B & C & D & G and find if this combination is repeated across the sheet and return/highlight value of Column A. (The sheet is large like 50,000 rows).

Thanks for your valuable help and time as always

 

[pboltonchina]

Try this on a copy of your data, it's something I got from this forum but never really used

Option Explicit

Sub FindDupeRows()
Dim LstRw As Long, ThsRw As Long, rng As Range
Application.ScreenUpdating = False

'/// This will remove any Highlighting prior to finding Dupes
With Rows("2:65536")
.Interior.ColorIndex = xlNone
End With

LstRw = Cells(Rows.count, "A").End(xlUp).Row
'/// This inserts a temporary column
Columns(1).Insert
With Cells(2, "A").Resize(LstRw - 1)
'/// This Joins everything in A, B, C, & D together for comparison
  .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]&RC[7]"
  .Value = .Value
End With
Set rng = [A2].Resize(LstRw - 1)
For ThsRw = LstRw To 2 Step -1
  If Application.WorksheetFunction.CountIf(rng, Cells(ThsRw, "A").Value) > 1 Then _
  '/// This highlights Dupes
    Rows(ThsRw).Interior.ColorIndex = 27
Next
'/// Deletes temporary column
Columns(1).Delete

Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

You will need and End If on this statement to avoid an error message.

If Application.WorksheetFunction.CountIf(rng, Cells(ThsRw, "A").Value) > 1 Then _
'/// This highlights Dupes
Rows(ThsRw).Interior.ColorIndex = 27
End If 'Add this to avoid error.

 

[Arafat]

Thanks for your timely help...

This works Great but when i try to concatenate a column which contains more data in a cell, it throws RUNTIME error 1004 "Unable to get the Countif worksheetfunction property ".

Does countif fail if cell contains large data ? i tried removing .WorksheetFunction but then i get Type mismatch error.

Thanks Zillions

 

[JackDanIce]

This may over come the countif problem you're experiencing:

Sub FindDupRows()

Dim i As Long, j As Long
Dim rng As Range

Application.ScreenUpdating = False

Cells.Interior.ColorIndex = xlNone

i = Range("A" & Rows.Count).End(xlUp).Row
With Range("A2:A" & i)
    .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]"
    .Value = .Value
End With

Columns(1).Insert
Set rng = Range("B2:B" & i)
For j = 2 To i
    Range("A" & j).Formula = "=COUNTIF(" & rng & ",B" & i & ")"
    .Value = .Value
    If Range("A" & j) > 1 Then Rows(j).Interior.ColorIndex = 27
Next j
Columns(1).Delete

Application.ScreenUpdating = True

End Sub

 

[Arafat]

Thanks for your code , however it give me compile error
in this piece of code . It stops near .Value and throws compile error "Invalid or Unqualified reference"

Columns(1).Insert
Set rng = Range("B2:B" & i)
For j = 2 To i
Range("A" & j).Formula = "=COUNTIF(" & rng & ",B" & i & ")"
.Value = .Value
If Range("A" & j) > 1 Then Rows(j).Interior.ColorIndex = 27
Next j
Columns(1).Delete


what could be the issue ?

 

[JackDanIce]

That's me not paying attention or testing the code! Try:

Sub FindDupRows()

Dim i As Long, j As Long
Dim rng As Range

Application.ScreenUpdating = False

Cells.Interior.ColorIndex = xlNone

i = Range("A" & Rows.Count).End(xlUp).Row
With Range("A2:A" & i)
    .FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[4]"
    .Value = .Value
End With

Columns(1).Insert
Set rng = Range("B2:B" & i)
For j = 2 To i
    With Range("A" & j)
      .Formula = "=COUNTIF(" & rng & ",B" & i & ")"
      .Value = .Value
      If .Value > 1 Then Rows(j).Interior.ColorIndex = 27
    End With
Next j
Columns(1).Delete

Application.ScreenUpdating = True

End Sub

See if that works

 

[Arafat]

Thanks for the fix I still get the Type mismatch error on COUNTIF statement.

 

[JackDanIce]

Change that line to:

.Formula = "=COUNTIF(B2:B" & i & ",B" & j & ")"

 

[Arafat]

Thanks, the code is free of errors, but it doesnt seem to work as per the requirement, its actually not highlighting the duplicates instead its doing it randomly.