VBA Macro to find duplicates from multiple columns

**tuppari** · 09-17-2012, 03:21 AM

Dear everyone

I have a workbook with multiple columns with differiating data. I would need to compare the values of Column A to every other column with data on it, and highlight duplicates. (Note, only column A should be used as a comparison value. So A should be compared with B C and D, but B should not be compared with C or D.

Attached example workbook.

Dummy1.xlsx

So this is what my start setup looks like.

User1 User2 User3 User4 User5
X1 X1 X5 X4 R2
Y2 Y2 R2 X3 Y2
Y3 Y3 Y4 Y1 Y9
X2 Y4 Y7 Y2 X1
X3 Y5 Y3 Y7
Y4 X2 X1
Y5 X2
X4 X4
X5
R2

And this is what it should look like after running the macro

User1 User2 User3 User4 User5
X1 X1 X5 X4 R2
Y2 Y2 R2 X3 Y2
Y3 Y3 Y4 Y1 Y9
X2 Y4 Y7 Y2 X1
X3 Y5 Y3 Y7
Y4 X2 X1
Y5 X2
X4 X4
X5
R2

The purpose of this macro is to find values from columns B - XX, that aren't found in column A.
As from this example, the values Y7 and Y9 were found.

In the data workbook we're using, there's around 70 columns of data.

**mike7952** · 09-17-2012, 05:08 AM

Give this a shot

Option Explicit
Sub abc()
 Dim LastRow As Long, LastCol As Long
 Dim rng As Range, rng2 As Range
 Dim Cell As Range, Cell2 As Range
 Dim RangeToBold As Range
 
 
 LastRow = Cells(Rows.CountLarge, "a").End(xlUp).Row
 LastCol = Cells(1, Columns.CountLarge).End(xlToLeft).Column
 
 
 Set rng = Range("a2:a" & LastRow)
 Set rng2 = Range(Cells(2, 2), Cells(LastRow, LastCol))
 
 For Each Cell In rng
    For Each Cell2 In rng2
        If Cell = Cell2 Then
            If RangeToBold Is Nothing Then
                Set RangeToBold = Range(Cell2.Address)
            Else
                Set RangeToBold = Union(RangeToBold, Range(Cell2.Address))
            End If
        End If
    Next
 Next
 If Not RangeToBold Is Nothing Then
    RangeToBold.Font.Bold = True
 End If
 Set rng = Nothing
 Set rng2 = Nothing
 Set Cell = Nothing
 Set Cell2 = Nothing
 Set RangeToBold = Nothing
 
End Sub

**kvsrinivasamurthy** · 09-17-2012, 05:21 AM

Pl see the attached file with Macro.

**mike7952** · 09-17-2012, 05:53 AM

@kvsrinivasamurthy
Your comparing row to row

Sorry tuppari I missed the hightlight, I thought you wanted it BOLDED

Option Explicit
Sub abc()
 Dim LastRow As Long, LastCol As Long
 Dim rng As Range, rng2 As Range
 Dim Cell As Range, Cell2 As Range
 Dim RangeToBold As Range
 
 
 LastRow = Cells(Rows.CountLarge, "a").End(xlUp).Row
 LastCol = Cells(1, Columns.CountLarge).End(xlToLeft).Column
 
 
 Set rng = Range("a2:a" & LastRow)
 Set rng2 = Range(Cells(2, 2), Cells(LastRow, LastCol))
 
 For Each Cell In rng
    For Each Cell2 In rng2
        If Cell = Cell2 Then
            If RangeToBold Is Nothing Then
                Set RangeToBold = Range(Cell2.Address)
            Else
                Set RangeToBold = Union(RangeToBold, Range(Cell2.Address))
            End If
        End If
    Next
 Next
 If Not RangeToBold Is Nothing Then
    'RangeToBold.Font.Bold = True
    RangeToBold.Interior.Color = vbYellow
 End If
 Set rng = Nothing
 Set rng2 = Nothing
 Set Cell = Nothing
 Set Cell2 = Nothing
 Set RangeToBold = Nothing
 
End Sub