PDA

View Full Version : Code to detect duplicate cells in Excel



worker101010
05-21-2019, 07:16 AM
Hello,

I am currently in need of a VBA code that will be able to detect if there are duplicate cells in two columns of data within two worksheets of two different workbooks. I need the code to display a message box (i.e. "there are duplicates present") if the information is found. One column of data is going to be substantially longer than the other. Need the code to go one by one through the Eval worksheet and compare each value in column F to the 200+ entries in column F of the other worksheet to see if the value has a duplicate.

Any guidance/help would be greatly appreciated. I can provide more information if needed.

Thank you!

Max_iR
05-21-2019, 08:13 AM
Try this :

Sub test()
Dim rng, rng2 As Range
Dim cel, cel2 As Range
lr1 = Workbooks("01").Sheets(1).Range("f" & Rows.Count).End(3).Row
lr2 = Workbooks("02").Sheets(1).Range("f" & Rows.Count).End(3).Row
Set rng = Workbooks("01").Sheets(1).Range("f1:f" & lr1)
Set rng2 = Workbooks("02").Sheets(1).Range("f1:f" & lr2)
For Each cel In rng
For Each cel2 In rng2
If cel <> "" And cel = cel2 Then
cel.Interior.ColorIndex = 3
cel2.Interior.ColorIndex = 3
End If
Next cel2
Next cel
MsgBox "there are duplicates present"
End Sub

worker101010
05-21-2019, 08:42 AM
Max,

That worked like a charm. I have been struggling with writing this code for hours now and your help was greatly appreciated.

Thank you!!!

Max_iR
05-21-2019, 09:22 AM
Just move the MsgBox into the loop :

Sub test()
Dim rng, rng2 As Range
Dim cel, cel2 As Range
lr1 = Workbooks("01").Sheets(1).Range("f" & Rows.Count).End(3).Row
lr2 = Workbooks("02").Sheets(1).Range("f" & Rows.Count).End(3).Row
Set rng = Workbooks("01").Sheets(1).Range("f1:f" & lr1)
Set rng2 = Workbooks("02").Sheets(1).Range("f1:f" & lr2)
For Each cel In rng
For Each cel2 In rng2
If cel <> "" And cel = cel2 Then
cel.Interior.ColorIndex = 3
cel2.Interior.ColorIndex = 3
MsgBox "there are duplicates present"
End If
Next cel2
Next cel
End Sub