Running Macro Crashes Excel - vba

Question

I'm trying to run a macro but now it keeps freezing excel.
It runs with 10 cells, but when the macro is applied to almost two hundred, it freezes and crashes.
Sub eancheck()
Dim s1 As Worksheet, s2 As Worksheet
Dim Msg As String
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet3")
Dim lr1 As Long, lr2 As Long
lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = s2.Range("a" & Rows.Count).End(xlUp).Row
Dim i As Long, j As Long
Application.ScreenUpdating = False
For i = 2 To lr1
s1.Cells(i, "D").Interior.ColorIndex = 0
For j = 2 To lr2
If s2.Range("A" & j) = s1.Range("D" & i) Then
's1.Range("D" & i) = s2.Range("B" & j)
s1.Cells(i, "D").Interior.ColorIndex = 3
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
I'm having problems with other macros too, and i think is because of the size of the range. How can i fix it?
Note: The macro runs when searching 10 values in a sheet with two columns with almost 200.000 values each, but when instead of 10 is 200, crashes.

Answer 1

Use conditional formatting in your sheet1 with formula and apply it on range like D2:D5000 or whatever is suitable.
=COUNTIF(Sheet3!A2,D2)>0

Answer 2

Try Declaring all the required variables separately.
Use Application.ScreenUpdating = false in the beginning of the program.
Your first line of for loop can be outside the for loop as well.
Use Collections to make the checks.
For Example, I started with data like this on Sheet 1 Col A,
And data like this on Sheet 3 Col A.
And this is the Macro that I have,
Sub eancheck()
Application.ScreenUpdating = False
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Msg As String
Dim lr1 As Long
Dim lr2 As Long
Dim i As Long
Dim j As Long
Dim Sheet1ObjectsCol As Collection
Dim Sheet3ObjectsCol As Collection
Dim IdentifierCol As Collection
Set s1 = ThisWorkbook.Sheets("Sheet1")
Set s2 = ThisWorkbook.Sheets("Sheet3")
Set Sheet1ObjectsCol = New Collection
Set Sheet3ObjectsCol = New Collection
Set IdentifierCol = New Collection
lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = s2.Range("a" & Rows.Count).End(xlUp).Row
s1.Range("D2" & ":" & "D" & lr1).Interior.ColorIndex = 0
'Load the collections
For i = 2 To lr1
Sheet1ObjectsCol.Add s1.Range("A" & i).Value
Next
'Load the collections
On Error Resume Next
For i = 2 To lr2
Sheet3ObjectsCol.Add s2.Range("A" & i).Value, CStr(s2.Range("A" & i).Value)
Next
'Create the Identifier Collection
For i = 1 To Sheet1ObjectsCol.Count
ColorValReq = 0
For j = 1 To Sheet3ObjectsCol.Count
If Sheet1ObjectsCol(i) = Sheet3ObjectsCol(j) Then
ColorValReq = 3
GoTo Idenitified
End If
Next
Idenitified:
IdentifierCol.Add ColorValReq
Next
For i = 1 To IdentifierCol.Count
j = i + 1
If IdentifierCol(i) = 3 then
s1.Range("D" & j).Interior.ColorIndex = IdentifierCol(i)
End if
Next
Application.ScreenUpdating = True
End Sub
And this is the output I got,