I am using the following routine to find out the quantity of entrees in one
list in one worksheet that are present in another worksheet list. The
routine then places the value in another sheet. It appears to complete the
task fine and would be okay except for the fact that my lists are as long as
30,000 entrees in each. Is there a more efficient way of writing this? The
section of the Code is below.

Thanks
Brad

Option Explicit
Sub Calculation()

Dim Row1, Row2, row3, r2, ct, yld, serial As Variant
Dim SN, SN1, SN2, r As Range
Dim y, z As Long
Dim ws, ws1, w3s, w2s, hh As Sheets
Dim i As Integer
Windows("Mod 100A Rework.xls").Activate

Set ws = Sheets("Thermal Shock Scan")
Set ws1 = Sheets("Rework Only")
Set w3s = Sheets("Mod 100a")
Set w2s = Sheets("Calculation Sheet")
Set ct = w2s.Range("C5:C11") 'Counter C6 = Rework Count
'C5 = Thermal Shock Count
'C7 = TS Rework Count
'C8 = Module 100a Count
'c9 = Mod 100a Rework Count
'C10 =Yield on 100a

Row1 = 5
r2 = w3s.Range("C65536").End(xlUp).Row
ct(4, 1) = r2 - Row1 + 1 ' Total parts run on 100a
w3s.Activate
With w3s 'Determine number of parts from 100a that were reworked
Set SN2 = w3s.Range(Cells(Row1, 3), Cells(r2, 3))
ct(5, 1) = 0
For Each r In SN2
serial = r.Value
ws1.Activate
row3 = ws1.Range("C65536").End(xlUp).Row
Set SN1 = ws1.Range(Cells(5, 3), Cells(row3, 3))
With SN1
Set y = .Find(serial, LookIn:=xlValues)
If y Is Nothing Then
ct(5, 1) = ct(5, 1)
Else
ct(5, 1) = ct(5, 1) + 1
End If
End With
Next r
End With

End Sub