VBA Code Keeps Crashing When Comparing Two Excel Sheets

Question

I wrote a VBA code to compare the content of two sheets containing order information for my company. Here's what I'm trying to accomplish

1. If the order is in the new sheet but not the old sheet, highlight the entire row in the new sheet.
2. If order information on an existing order has changed from the old sheet (ex. delivery date), highlight the changed cell in the new sheet.

Below is my code but the For Loop keeps crashing after 1000 rows...I feel like my code is inefficient. I'm new to Excel VBA so I would really appreciate any help.

Private Sub test()

    Sheets("New Sheet").Select
    Row = 2
    Cells(Row, 1).Select
    
    Dim cell As Range
    Dim BigCell As Range
    
    For i = 1 To 3000
        If Not IsEmpty(ActiveCell.Offset(0, 2)) Then 'Run check if Column C is not blank
            PIModel = ActiveCell.Value
                
            Sheets("Old Sheet").Select
            Columns("A:A").Select
            Set findPIModel = Selection.Find(What:=PIModel, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            
            If (findPIModel Is Nothing) Then
                Sheets("New Sheet").Select
                ActiveCell.Columns("A:X").Interior.ColorIndex = 37
                
                Row = Row + 1
                Cells(Row, 1).Select
            Else
                findPIModel.Activate
                'Skipping a few columns because I don't need to run check on all of them
                Column = 19
                Columnoffset = 18
                
                For Each cell In Sheets("New Sheet").Range("A1:P1")
                    If Not Worksheets("New Sheet").Cells(Row, Column).Value = ActiveCell.Offset(0, Columnoffset).Value Then
                        Worksheets("New Sheet").Select
                        Cells(Row, Column).Interior.ColorIndex = 37
                        
                        Column = Column + 1
                        Columnoffset = Columnoffset + 1
                        
                        Worksheets("Old Sheet").Select
                        Cells(Row, 1).Select
                    End If
                Next
            
                Row = Row + 1
                Sheets("New Sheet").Select
                Cells(Row, 1).Select
            End If
        Else: Exit For
        End If
    Next i
End Sub

Answer 1

Here is a code which maybe is a bit larger than yours but will definetly work faster and more efficiently. The code is commented so it should be enough for you to toy with it.

Option Explicit
Sub Test()
    
    'First we are going to store the old sheet in a dictionary
    'For That you need to go to Tools->References->Check the "Microsoft Scripting Runtime" library
    'To learn more about dictionaries, how to use them and why: http://www.snb-vba.eu/VBA_Dictionary_en.html
    Dim OldSheet As Dictionary
    Set OldSheet = LoadOldSheet(ThisWorkbook.Sheets("Old Sheet").UsedRange.Value)
    
    'Now we store the new sheet inside an array (to work faster)
    'To learn more about arrays, how to use them and why: http://www.snb-vba.eu/VBA_Arrays_en.html
    Dim arr As Variant: arr = ThisWorkbook.Sheets("New Sheet").UsedRange.Value
    Dim MyString As String
    Dim HighLightRange As Range
    Dim i As Long
    'Now we loop through the new sheet finding the rows which will not match with the old sheet
    For i = 2 To UBound(arr)
        If arr(i, 1) = vbNullString Then Exit For
        For j = 1 To 16
            MyString = MyString & LCase(arr(i, j))
        Next j
        'If the row doesn't match with the old sheet then we store the range A:P for that row in a variable
        If Not OldSheet.Exists(MyString) Then
            With ThisWorkbook.Sheets("New Sheet")
                If HighLightRange Is Nothing Then
                    Set HighLightRange = .Range("A" & i & ":P" & i)
                Else
                    Set HighLightRange = Union(HighLightRange, .Range("A" & i & ":P" & i))
                End If
            End If
        MyString = vbNullString
    Next i
    'When we stored all the rows which won't match, highlight them all at once
    If Not HighLightRange.Range Is Nothing Then HighLightRange.Interior.ColorIndex = 37

End Sub
Private Function LoadOldSheet(arr As Variant) As Dictionary
    'How we are going to load the old sheet in a dictionary is simple,
    'we store the columns A to P as the key (in Low Case)
    
    Set LoadOldSheet = New Dictionary
    Dim i As Long, j As Long
    Dim MyString As String 'A PlaceHolder variable to store all the columns at once
    'Note that I'm starting at row 2 counting that you have headers in row 1
    For i = 2 To UBound(arr)
        'Here I'm counting that in the old sheet all your rows in column A are filled.
        'If not, the function will end where it finds a blank cell.
        If arr(i, 1) = vbNullString Then Exit For
        '(1 is index number for column A and 16 is index number for column P)
        For j = 1 To 16
            MyString = MyString & LCase(arr(i, j))
        Next j
        'Here we store the whole range A:P from the row we are in
        LoadOldSheet.Add MyString, 1
        'Reset the variable
        MyString = vbNullString
    Next i
    
End Function