I have 400 000 records in two sheets with 5 columns each with data in column A being the unique identifier. Order of the columns in both the sheets is same. I am trying to search for record that exists in Sheet1 and find it in Sheet2. If found, I need to compare the data of that record with the one in sheet2. Mismatched data should highlight the cells in sheet1 and copy the entire row in sheet 3.
My macro works successfully for small set of data but it gets hanged with large data and excel gets closed automatically.
I tried commenting the highlighting of cells and only copying the row and also separating only 25000 records but could see the same performance issue as stated earlier.
Sub CompareSheets()
Dim wS As Worksheet, wT As Worksheet, RS As Worksheet
Dim intSheet1Column As Integer, i As Long, j As Long, k As Long, FoundRow As Long
Set wS = ThisWorkbook.Worksheets("Sheet1")
Set wT = ThisWorkbook.Worksheets("Sheet2")
Set RS = ThisWorkbook.Worksheets("Sheet3")
RS.Cells.ClearContents
RS.Cells.Interior.Color = RGB(255, 255, 255)
wS.Rows(1).EntireRow.Copy RS.Range("A1")
On Error Resume Next
For i = 2 To wS.UsedRange.Rows.Count
For j = 2 To wT.UsedRange.Rows.Count
If InStr(1, wT.Range("A"& j).Value, wS.Range("A"& i).Value) > 0 Then
Match = "FOUND"
FoundRow = j
Exit For
End If
Next
If Match = "FOUND" Then
CopyFlag = False
For intSheet1Column = 2 To wS.UsedRange.Columns.Count
If wS.Cells(i, intSheet1Column).Value <> wT.Cells(FoundRow, intSheet1Column).Value Then
wS.Cells(i, intSheet1Column).Interior.Color = RGB(255, 255, 0)
CopyFlag = True
k = RS.UsedRange.Rows.Count
End If
Next
If CopyFlag = True Then
wS.Rows(i).EntireRow.Copy RS.Range("A"& k + 1)
End If
End If
Next
MsgBox "Validation Complete"
End Sub
Excel gets hanged and closes off automatically.