I have a workbook that loads in the results of an SQL query into two worksheets called Old and New. The New worksheet is then edited by an end user. Rows can be inserted, deleted and values changed. There is a unique key in column M. With the following code, I am able to detect changes between Old and New, additions and deletions but it is slow and can take 10+ minutes to execute when looking at 5000+ rows. Would appreciate any advice in making this a faster process.
Sub Compare() Dim OldArray as Variant Dim NewArray as Variant 'Load List objects into arrays. OldArray = Old.DataBodyRange NewArray = New.DataBodyRange For i = LBound(OldArray) to UBound(OldArray) OldValueToFind = OldArray(i,IDColumn) 'Find the ID value in the i row. With Sheets("New").Range("M:M") 'ID Column Set NewRng = .Find(What:=OldValueToFind, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True) If Not NewRng Is Nothing Then 'Found OldValue in New Worksheet NewRowIndex = NewRng.Row - 1 'Remove header column For j = LBound(OldArray, 2) to UBound(OldArray, 2) 'For each column in Old If j <> 2 and j <> 9 and j <> 10 and j <> 11 and j < 14 Then 'We don't care about comparing these value. There has to be a better way to discard these. If OldArray(i,j) <> NewArray(NewRowIndex, j) Then 'Add new row to 3rd worksheet with differences End If End If Next Else 'Add new row to 3rd worksheet as this record has been deleted End If End With Next 'End of checking for deletions and changes 'Now to repeat for NewArray to find any additional rows added. For i = LBound(NewArray) to UBound(NewArray) NewRowValue = NewArray(i, IDColumn) 'Get ID Value from New Worksheet With Sheets("Old").Range("M:M") Set viewRng = .Find(What:=NewRowValue, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True) If viewRng Is Nothing Then 'Must be additional row as not found 'Add new row to 3rd worksheet with all required columns. End If End With Next End Sub ```