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.
VBA Code:
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