0
\$\begingroup\$

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
    
```
\$\endgroup\$
3
  • \$\begingroup\$ Have you already tried using the comapare feature built-in to Excel? \$\endgroup\$
    – HackSlash
    Aug 16 '21 at 23:25
  • \$\begingroup\$ This was resolved on another forum. mrexcel.com/board/threads/… \$\endgroup\$
    – Jazattack
    Aug 17 '21 at 4:05
  • \$\begingroup\$ If you've solved it yourself then you could still put the new code up for review in a separate question? Alternatively, if you could add the commented out 'Add new row to 3rd worksheet code/ post your full code you might get better answers, as that will probably have a big impact on your code's performance \$\endgroup\$
    – Greedo
    Aug 18 '21 at 10:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.