0

I'm facing a problem with one of the macros I've written to compare the rows in a sheet and highlight the duplicates if any. But, it is taking longer time to complete it's operation when there are more number of records. When the comparision starts, it picks up the first record, compares it with all the remaining records and highlight if there is a duplicate and then moves on to the second record and this process continues till the last record.

Can anybody tell me a better solution for this?

Here is my code;

RowCount = ActiveSheet.UsedRange.Rows.Count
ColumnCount = ActiveSheet.UsedRange.Columns.Count
For frownum = 1 To RowCount
    For rownum = 1 To RowCount
        RecFound = 0
                For colnum = 1 To ColumnCount
                        If frownum <> rownum Then
                            If ActiveSheet.Cells(frownum, colnum).Value = ActiveSheet.Cells (rownum, colnum).Value Then
                              RecFound = RecFound + 1
                            End If
                        End If
                Next colnum

        If ColumnCount = RecFound Then
             For errRow = 1 To ColumnCount
                  ThisWorkbook.Worksheets("RowCompare").Cells(frownum, errRow).Interior.Color = RGB(251, 231, 128)
             Next errRow
        End If
     Next rownum
Next frownum
  • look into this question [How to compare two entire rows in a sheet](http://stackoverflow.com/questions/19395633/how-to-compare-two-entire-rows-in-a-sheet) – Dmitry Pavliv Apr 14 '14 at 09:25

1 Answers1

0
Sub test2()
    Dim rowCount As Long
    Dim columnCount As Long

    '//You need "Microsoft Scripting Runtime" library for this to work
    '//You can add this library by going Tools -> References -> Browse...
    '//Find "scrrun.dll" file in your System32 folder
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary

    Dim ws As Worksheet
    Set ws = activesheet

    With ws
        rowCount = .UsedRange.Rows.Count
        columnCount = .UsedRange.Columns.Count

        Dim i  As Long
        For i = 1 To rowCount
            Dim rng As Range
            Dim joinedRow As String
            Set rng = Range(.Cells(i, 1), .Cells(i, columnCount))
            joinedRow = Join(Application.Transpose(Application.Transpose(rng)), Chr(0))

            If dict.Exists(joinedRow) Then
                rng.Interior.Color = RGB(251, 231, 128)
            Else
                dict.Add joinedRow, 1
            End If
        Next i
    End With
End Sub

Improved ideas, used here: How to compare two entire rows in a sheet to your case, adding Scripting.Dictionary class.

Hope it works.

Community
  • 1
  • 1
Suobig
  • 41
  • 5
  • 1
    While a marked improvement on the OP, this will still be _very_ slow for large ranges. Move the data to a variant array, and loop that. `Join Transpose Transpose` is also slow compared to a loop over a row of data. – chris neilsen Apr 14 '14 at 11:29